Microsoft 365 Ecrire une formule de calcul en Vba Excel

N

NONO14

XLDnaute Impliqué
Bonjour à toutes et à tous,

Comment pourrait-on écrire cette formule de calcul en Vba, s'il vous plaît ? Pour le moment elle est écrite en dur dans des cellules Excel de mon tableau.
Cependant, il m'est demandé de l'écrire dans du code afin que personne ne puisse y accéder. Cette formule se trouve dans la colonne J du tableau de la feuille "Recap", il y en d'autres du même genre dans les colonnes K et L et un peu plus simples dans les colonnes M, N, O.
Bien sûr je pourrais protéger ces colonnes mais ce n'est pas ce qui m'est demandé, j'ai proposé cette solution, mais elle ne garantie pas une sécurité suffisante en cas d'effacement malencontreux par la personne qui va gérer ce fichier.
MAX_MAT et autres sont des Noms donnés à des cellules de la feuille "Données", soit les cellules L3 à O5.
Mot de passe de la feuille "falaise"
Merci par avance pour vos idées.
VB: 
=SI(A2="";"";SI(A2<>"";SI(ET(D2<>"";E2<>"");E2-D2;SI(ET(D2<>"";E2="";F2<>"");MAX_MAT-D2;SI(ET(D2<>"";E2="";ET(F2<>"";G2=""));"";SI(ET(D2<>"";E2="";F2="";G2="";H2="";I2<>"");MAX_MAT-D2;SI(ET(D2<>"";E2="";F2="";G2<>"");MAX_MAT-D2;SI(ET(D2<>"";E2="";ET(F2="";G2="");ET(H2="";I2<>""));I2-D2;SI(ET(D2<>"";E2="";F2="";G2="");MAX_MAT-D2;SI(D2="";""))))))))))
 

Pièces jointes

  • Tablo_Heures.xlsm
    282.8 KB · Affichages: 16
Dernière édition:
Solution
ChTi160
Bonjour le Fil
juste pour signaler qu'a ce Niveau il y a un problème !
VB: 
Private Sub TextCode_Change()
Dim Ctrl As Control
Dim Ctrl2 As Control
Dim Trouvé As Boolean
 Dim Trouve As Range

    Me.TextCode.Text = UCase(Me.TextCode) 'On met en Majuscule tout le Contenu du TextBox
    If Not EnableEvents Then Exit Sub
    Sheets("Liste_agents").Unprotect "falaise"
    'on cherche le nom associé au code dans la TS "t_Noms"
    With Sheets("Liste_agents").ListObjects("t_Noms")
    'ci-dessous on recherche dans une colonne ou se trouvent des Minuscules
    Set Trouve = .ListColumns(1).Range.Find(Me.TextCode, lookat:=xlWhol
Tu peux si la case n'a pas d'importance mettre Option Compare Text en tête de Module.
et supprimer ...
Trier par date Trier par votes
N

NONO14

XLDnaute Impliqué
vgendron à dit:
Hello

dans le code du TexCode_Change,
il y a des redondances ==> tu refais ce qui a été fait juste avant..

1) la boucle que je t'ai expliquée, affiche ou masque les CheckBox si il y a une saisie ou pas dans le textbox associé

2) ensuite, il y a une serie de test "if..... then" pour chaque checkbox ==> ca refait la meme chose ==> inutile

3) après tu as toute la série des if pour afficher ou pas, et mettre le message d'autorisation de badger
l'usine à gaz est peut etre la...
mais encore une fois.. ca refait ce qui a déjà été fait dans la boucle..
==> comme il semble y avoir pas mal de conditions dans ces if, peut etre que c'est la boucle qui est inutile...?

Dans le code de "CalculerTotalJournée"
il faut revoir, parce que tu y a fait des modifs par rapport à mon original qui n'ont pas de sens..
exemple
Total=cdate(Total=0)

(Total=0)==> retourne Vrai ou faux
cdate( vrai ou faux)==> ca ne donnera jamais une date
enfin.. si.; mais pas du tout ce que tu penses
Vrai = 1==> Cdate(1) = 01/01/1900 00:00
Faux=0 ==>Cdate(0) = 00/01/1900 00:00
Cliquez pour agrandir...
Lorsque j'écris Total=0, je veux dire que le résultat du calcul sera zéro.
Apparemment ce n'est pas la bonne façon de faire.
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
pour le calcul total, il faut "juste" définir comment tu calcules lorsqu'il manque des pointages
VB: 
Public Sub CalculerTotalJournée() 'à revoir
Dim Total As Date

    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat <> "" Then Total = CDate(Me.Tbx_FinMat) - CDate(Me.Tbx_DebMat) 'total du matin si deux pointages le matin
    If Me.Tbx_DebAPM <> "" And Me.Tbx_FinAPM <> "" Then Total = Total + CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebAPM) 'on rajoute le total de l'APM si deux pointages l'APM
    If Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then Total = Total + CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir) 'on rajoute le total du soir si deux pointages le soir
 
    'traiter ensuite les cas ou un seul pointage sur deux a été fait ??
    
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" Then
        Total = CDate(Total = 0) 'calcul erroné ==> mettre Total=0 suffit
    End If
    
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM <> "" Then
        Total = CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebMat) 'pas de pause du midi?
    End If
    
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir = "" Then
        Total = CDate(Total = 0) 'calcul erroné ==> mettre Total=0 suffit
    End If
    
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebMat) 'journée continue?
    End If
    
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM <> "" And Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebMat) + CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir)
    End If
    
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir)
    End If
    
    If Me.Tbx_DebMat = "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Total = 0) 'calcul erroné ==> mettre Total=0 suffit
    End If
    
    If Me.Tbx_DebMat = "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM <> "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebAPM)
    End If
    
    Me.T_bx_TotJour = CDate(Total)
    Me.T_bx_TotJour = Application.Text(Total, "[h]:mm")
End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
vgendron à dit:
pour le calcul total, il faut "juste" définir comment tu calcules lorsqu'il manque des pointages
VB: 
Public Sub CalculerTotalJournée() 'à revoir
Dim Total As Date

    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat <> "" Then Total = CDate(Me.Tbx_FinMat) - CDate(Me.Tbx_DebMat) 'total du matin si deux pointages le matin
    If Me.Tbx_DebAPM <> "" And Me.Tbx_FinAPM <> "" Then Total = Total + CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebAPM) 'on rajoute le total de l'APM si deux pointages l'APM
    If Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then Total = Total + CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir) 'on rajoute le total du soir si deux pointages le soir
 
    'traiter ensuite les cas ou un seul pointage sur deux a été fait ??
   
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" Then
        Total = CDate(Total = 0) 'calcul erroné ==> mettre Total=0 suffit
    End If
   
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM <> "" Then
        Total = CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebMat) 'pas de pause du midi?
    End If
   
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir = "" Then
        Total = CDate(Total = 0) 'calcul erroné ==> mettre Total=0 suffit
    End If
   
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebMat) 'journée continue?
    End If
   
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM <> "" And Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebMat) + CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir)
    End If
   
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir)
    End If
   
    If Me.Tbx_DebMat = "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM = "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Total = 0) 'calcul erroné ==> mettre Total=0 suffit
    End If
   
    If Me.Tbx_DebMat = "" And Me.Tbx_FinMat = "" And Me.Tbx_DebAPM <> "" And Me.Tbx_FinAPM = "" And Me.Tbx_DebSoir = "" And Me.Tbx_FinSoir <> "" Then
        Total = CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebAPM)
    End If
   
    Me.T_bx_TotJour = CDate(Total)
    Me.T_bx_TotJour = Application.Text(Total, "[h]:mm")
End Sub
Cliquez pour agrandir...
Tu as raison concernant le temps de pause qui est à déterminer selon le planning de travail.
Un(e) employé(e) commençant à 11h00 n'aura pas sa pause au même moment que celui ou celle commençant à 6, 7 ou 8h. Je ne sais pas encore comment on va appliquer ça, c'est pourquoi, pour le moment j'ai besoin de ces calculs. Pour un planning normal, arrivée/départ le matin ou après-midi ou soir ne va pas engendré de problème, mais les plannings sur plusieurs plages ça risque de se compliquer. Est-ce que le responsable va imposer une pause ou pas, cela va dépendre du temps de travail. En tout état de cause, d'après les informations reçues, le temps de travail devrait rarement dépasser le temps prévu au planning de chacun ou chacune.
Cependant, merci beaucoup pour la correction du code.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Bonjour à toutes et à tous,
Juste une petite question, est-ce qu'un formulaire Mot de Passe peut servir pour plusieurs applications au sein d'un même fichier ? Je m'explique : Un utilisateur veut accéder à la feuille1, le formulaire s'affiche et on lui demande le mot de passe. Ensuite, il veut accéder à l'ouverture de l'UfGestTemps, est-ce que je peux utiliser le même formulaire mot de passe que précédemment ? Ou bien dois-je créer un formulaire Mot de Passe pour chaque action ?
J'espère être suffisamment clair dans mes explications.
Merci par avance pour votre aise
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Voilà j'ai fais ça et ça à l'air de fonctionner. Il me reste à terminer ce qui est en-dessous de UfGestTemps.Multipage.
Est-ce que cela te parait correct comme façon de faire ?

VB: 
Private Sub ComboMenus_Change() 'à revoir
Const MdP As String = "Admin01"
Dim Mdp1 As Variant, x As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Select Case ComboMenus
        
        Case "Enregistrer un(e) employé(e)"
            'Demande de Mot de Passe = Admin01
            For x = 3 To 1 Step -1
                Mdp1 = Application.InputBox("Entrez le mot de passe" & Chr(10) & "Il vous reste " & x & " essais")
                If VarType(Mdp1) = vbBoolean Then Exit For
                    If Mdp1 = MdP Then
                Lance 'module de lancement UfGestTemps.Show dans module 1
            Exit For
                End If
            Next x
            'Mettre le focus sur la page (0) du formulaire
            UfGestTemps.MultiPage1.Value = 0
            'Sheets ("Liste agents").activate
            'La feuille est déverrouillée pour la saisie et reverrouillée
            'La Combo revient à zéro
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Formule si est vide
Réponses
9
Affichages
436
Marvin57
M
F
  • Résolu(e)
XL 2013 Resultat en fonction de 3 conditions cumultatives
Réponses
2
Affichages
335
franxy
F
M
  • Question
XL 2019 Recherche d'un mot dans une chaîne de caractère depuis une plage de références puis si présent renvoyer la référence
Réponses
7
Affichages
461
MilieBZH
M
HamoudaBA
  • Question
XL 2021 RESOLU recherchev vba sur autre feuille
Réponses
10
Affichages
768
HamoudaBA
HamoudaBA
C
  • Question
Microsoft 365 Formule Excel qui additionne la tarification quotidienne
Réponses
2
Affichages
172
TooFatBoy
TooFatBoy
D
  • Question
Microsoft 365 Excel fonction SI
Réponses
5
Affichages
406
dede869
D
M
  • Résolu(e)
XL 2013 Calcul des heures travaillées de jour, de nuit et plus de 24h consécutives
2 3
Réponses
41
Affichages
2 K
Manutela
M
M
  • Question
Microsoft 365 "Vous avez un nombre trop important d'arguments pour cette fonction"
Réponses
11
Affichages
399
TooFatBoy
TooFatBoy
F
  • Résolu(e)
Microsoft 365 comptage de cellules
Réponses
3
Affichages
224
FRB78
F
D
  • Résolu(e)
Microsoft 365 Copier / coller données spécifiques documents txt vers Excel
Réponses
3
Affichages
554
Staple1600
Staple1600

Membres actuellement en ligne

1 membres et 87 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 333
Membres
111 103
dernier inscrit
Maxime@mar