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é
Bonjour à toutes et à tous et bon dimanche
Ce code qui devrait normalement me donner le total des heures réalisées dans la journée fonctionne en partie.
Je m'explique : Si l'employé(e) arrive à 8h00 et repart à 12h, j'ai bien un total de 4 heures, le total se fait correctement si il y a une arrivée et un départ pour chaque partie de la journée (matin, APM, soir).
Mais si l'employé(e) pointe à 8h00 le matin et pointe son départ à 18h l'après-midi, ce qui est possible, alors je n'ai pas de total des heures. Le calcul doit se faire dés lors qu'il ait une arrivée et un départ, si cela n'est pas fait dans la même partie de la journée.
Comment puis-je faire le calcul ?
Je vous remercie par avance pour vos idées.
Le fichier se trouve au post #171

VB: 
Public Sub CalculerTotalJournée()
Dim Total As Date
    If Me.Tbx_DebMat <> "" And Me.Tbx_FinMat <> "" Then
        Total = CDate(Me.Tbx_FinMat) - CDate(Me.Tbx_DebMat)
    End If
    If Me.Tbx_DebAPM <> "" And Me.Tbx_FinAPM <> "" Then
        Total = Total + CDate(Me.Tbx_FinAPM) - CDate(Me.Tbx_DebAPM)
    End If
    If Me.Tbx_DebSoir <> "" And Me.Tbx_FinSoir <> "" Then
        Total = Total + CDate(Me.Tbx_FinSoir) - CDate(Me.Tbx_DebSoir)
    End If
   
    Me.T_bx_TotJour = Format(Total, "hh:mm")
End Sub
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
NONO14 à dit:
Mais si l'employé(e) pointe à 8h00 le matin et pointe son départ à 18h l'après-midi, ce qui est possible, alors je n'ai pas de total des heures. Le calcul doit se faire dés lors qu'il ait une arrivée et un départ, si cela n'est pas fait dans la même partie de la journée.
Comment puis-je faire le calcul ?
Cliquez pour agrandir...
Je n'ai pas de réponse, mais juste une question : considères-tu toujours qu'un employé peut oublier de pointer, ou au contraire qu'il est impossible qu'il y ait un oubli ?
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Je n'ai pas de réponse, mais juste une question : considères-tu toujours qu'un employé peut oublier de pointer, ou au contraire qu'il est impossible qu'il y ait un oubli ?
Cliquez pour agrandir...
Bonjour TootFatBoy,
Il est envisageable qu'un ou une employé(e) puisse oublier de pointer, dans ce cas, seul le responsable sera habilité à entrer l'horaire manquant.
Sinon, je pense faire le calcul au niveau du tableau de la feuille "Saisie" ce qui sera certainement plus facile.
Qu'en penses-tu ?
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Je pensais m'aider de ce code que j'ai trouvé, il répond à-peu-près à mon besoin.
Je ferai donc le calcul dans la feuille "Saisie" et récupérer la donnée dans mon formulaire.
Qu'en penses-tu ?

VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("A:F")) Is Nothing Then
 
On Error GoTo ErrorHandler
 
Dim ma_row As String
ma_row = ActiveCell.Row - 1
 
Dim ma_ligne As String
Dim ma_valeur_MATIN As Variant
Dim ma_valeur_APREM As Variant
Dim ma_valeur_SOIR As Variant
Dim A7 As Variant
Dim B7 As Variant
Dim C7 As Variant
Dim D7 As Variant
Dim E7 As Variant
Dim F7 As Variant
 
ma_ligne = ma_row
A7 = Range("A" & ma_ligne).Value
B7 = Range("B" & ma_ligne).Value
C7 = Range("C" & ma_ligne).Value
D7 = Range("D" & ma_ligne).Value
E7 = Range("E" & ma_ligne).Value
F7 = Range("F" & ma_ligne).Value
 
'MATIN
If (A7 <> "" And B7 <> "") Then
ma_valeur_MATIN = B7 - A7
Else
    If (A7 <> "" And B7 = "" And (C7 <> "" And D7 <> "")) Then
    ma_valeur_MATIN = ""
    Else
        If (A7 <> "" And B7 = "" And (E7 <> "" And F7 <> "")) Then
        ma_valeur_MATIN = ""
        Else
            If ((A7 <> "" And B7 = "" And C7 = "" And D7 <> "") Or (A7 <> "" And B7 = "" And E7 = "" And F7 <> "")) Then
            ma_valeur_MATIN = Range("Max_Matin").Value - A7
            Else
            ma_valeur_MATIN = ""
            End If
        End If
    End If
End If
Range("G" & ma_row).Value = ma_valeur_MATIN
 
'APREM
If (C7 <> "" And D7 <> "") Then
ma_valeur_APREM = D7 - C7
Else
    If (C7 <> "" And D7 = "" And (E7 <> "" And F7 <> "")) Then
    ma_valeur_APREM = ""
    Else
        If (C7 <> "" And D7 = "" And E7 = "" And F7 <> "") Then
        ma_valeur_APREM = Range("Max_PM").Value - C7
        Else
            If (C7 = "" And D7 = "" And B7 = "" And E7 = "" And A7 <> "" And F7 <> "") Then
            ma_valeur_APREM = Range("Max_PM").Value - Range("Min_PM").Value
            Else
                If (A7 <> "" And B7 = "" And C7 = "" And D7 <> "" And E7 = "" And F7 = "") Then
                ma_valeur_APREM = D7 - Range("Min_PM").Value
                Else
                ma_valeur_APREM = ""
                End If
            End If
        End If
    End If
End If
Range("H" & ma_row).Value = ma_valeur_APREM
 
'SOIR
If (E7 <> "" And F7 <> "") Then
ma_valeur_SOIR = F7 - E7
Else
    If (E7 <> "" And F7 = "") Then
    ma_valeur_SOIR = ""
    Else
        If (E7 = "" And F7 <> "" And ((A7 <> "" Or C7 <> "") And B7 = "" And D7 = "")) Then
        ma_valeur_SOIR = F7 - Range("Min_Soir").Value
        Else
        ma_valeur_SOIR = ""
        End If
    End If
End If
 
Range("I" & ma_row).Value = ma_valeur_SOIR
End If
Application.ScreenUpdating = True
 
ErrorHandler:
    Application.ScreenUpdating = True
    Exit Sub
 
End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Oui, si tu as besoin d'un coup de main il fait que tu commences par définir, et nous communiquer, une stratégie de calcul des heures.
Cliquez pour agrandir...
J'ai regardé un peu les possibilités de pointages et cela donne 45 possibilités, ce qui à encoder est titanesque.
Alors je vais me cantonner au calcul par plage. (FinMat - DebMat), (FinAPM - DebAPM), (FinSoir - DebSoir), (FinAPM - DebMat), (FinSoir - DebMat), (FinSoir-DebAPM), sinon je vais y passer ma vie.
A moins que quelqu'un ait une proposition pour gérer tous les cas.
Je vais arrêter là pour aujourd'hui, je reprendrai demain...
Merci encore pour ton aide
Je te souhaite une agréable soirée.

DebMATFinMATDebAPMFinAPMDebSOIRFinSOIR
8:00
8:0012:00
8:0012:0014:00
8:0012:0014:0018:00
8:0012:0014:0018:0020:00
8:0012:0014:0018:0020:0023:00
8:0012:0014:0023:00
8:0012:0014:0020:0023:00
8:0012:0014:0018:0023:00
8:0012:0018:0020:0023:00
8:0012:0018:0023:00
8:0014:00
8:0014:0018:00
8:0014:0018:0020:00
8:0014:0018:0020:0023:00
8:0014:0018:0023:00
8:0014:0020:0023:00
8:0014:0023:00
8:0020:0023:00
8:0023:00
12:00
12:0014:00
12:0014:0018:00
12:0014:0018:0020:00
12:0014:0018:0020:0023:00
12:0014:0023:00
12:0014:0020:0023:00
12:0018:00
12:0018:00
12:0018:0020:00
12:0018:0020:0023:00
12:0018:0023:00
14:00
14:0018:00
14:0018:0020:00
14:0018:0020:0023:00
14:0018:0023:00
14:0020:0023:00
14:0023:00
18:00
18:0020:00
18:0020:0023:00
18:0023:00
23:00
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
NONO14 à dit:
J'ai regardé un peu les possibilités de pointages et cela donne 45 possibilités, ce qui à encoder est titanesque.
Cliquez pour agrandir...
T'as dû en oublier une vingtaine. 😅

C'est aussi pour ça que je te disais que normalement il suffit à l'employé d'indiquer deux choses : l'heure et le sens dans lequel il va (entrée ou sorite).


Ceci dit, je ne vois pas bien comment dépatouiller tout ça, à part n'effectuer le calcul de la durée de présence que lorsqu'il y a autant d'entrées que de sorties.... :(
 
Dernière édition:
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
T'as dû en oublier une vingtaine. 😅

C'est aussi pour ça que je te disais que normalement il suffit à l'employé d'indiquer deux choses : l'heure et le sens dans lequel il va (entrée ou sorite).


Ceci dit, je ne vois pas bien comment dépatouiller tout ça, à part n'effectuer le calcul de la durée de présence que lorsqu'il y a autant d'entrées que de sorties.... :(
Cliquez pour agrandir...
Bonjour ToutFatBoy, Bonjour à toutes et à tous,
C'est possible que j'en ai oublié. Je vais faire le calcul sur autant de sorties que d'entrées.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Bonsoir à toutes et à tous,
J'ai mis en place code qui permet de rétablir tous les objets du formulaire "UfPointage" à leurs états d'origine lorsque l'on clique sur le bouton "Annuler". Cependant, je suis obligé de cliquer 2 fois pour que les CheckBoxs "Deb" redeviennent bleues car un autre code les colore en rouge s'il y a un pointage du soir sans pointage du matin. Pour le moment je ne l'ai réalisé que dans ce sens, ensuite je ferais l'inverse, rouge si pointage le matin sans pointage le soir.
J'ai également mis en place le code pour le calcul des heures et ça n'a pas été simple, j'ai fait au plus fréquent.
Voici le code pour le bouton "Annuler" ainsi que mon fichier.

VB: 
Private Sub Btx_Annul_Click()
Dim Ctrl As Control
    
    For Each Ctrl In Frame2.Controls
Me.Chk_DebMat.BackColor = RGB(160, 255, 255)
Me.Chk_DebAPM.BackColor = RGB(160, 255, 255)
Me.Chk_DebSoir.BackColor = RGB(160, 255, 255)
        
        Select Case TypeName(Ctrl)
    
    Case "CheckBox"
Ctrl.Value = False
Ctrl.Enabled = True
Ctrl.Visible = True
    
    Case "TextBox"
Ctrl.Value = ""

End Select

Next Ctrl


Me.TextCode.Value = ""
Me.T_bx_Noms.Value = ""
Me.Lbx_Information.Caption = "Veuillez saisir votre code employé(e)"

End Sub
 

Pièces jointes

  • PointHeure6.xlsm
    691.1 KB · Affichages: 4
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Hello

bon.. j'ai pas tout suivi depuis la dernière fois
mais dans ton code.. pourquoi ne pas commencer par vider les textbox avant de les décolorer

VB: 
Private Sub Btx_Annul_Click()
Dim Ctrl As Control

    Me.TextCode.Value = ""
    Me.T_bx_Noms.Value = ""
    Me.Lbx_Information.Caption = "Veuillez saisir votre code employé(e)"
    
    For Each Ctrl In Frame2.Controls
        Me.Chk_DebMat.BackColor = RGB(160, 255, 255)
        Me.Chk_DebAPM.BackColor = RGB(160, 255, 255)
        Me.Chk_DebSoir.BackColor = RGB(160, 255, 255)
        
        Select Case TypeName(Ctrl)
            Case "CheckBox"
                Ctrl.Value = False
                Ctrl.Enabled = True
                Ctrl.Visible = True
            Case "TextBox"
                Ctrl.Value = ""
        End Select
    Next Ctrl
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
bon.. en testant, il faut aussi
1) déclarer une variable public tout en haut du code (hors procédure)
Public EnableEvents As Boolean
2) modifier la macro
Code: 
Private Sub Btx_Annul_Click()
Dim Ctrl As Control
EnableEvents = False
    Me.TextCode.Value = ""
    Me.T_bx_Noms.Value = ""
    Me.Lbx_Information.Caption = "Veuillez saisir votre code employé(e)"
    
    For Each Ctrl In Frame2.Controls
        Me.Chk_DebMat.BackColor = RGB(160, 255, 255)
        Me.Chk_DebAPM.BackColor = RGB(160, 255, 255)
        Me.Chk_DebSoir.BackColor = RGB(160, 255, 255)
        
        Select Case TypeName(Ctrl)
            Case "CheckBox"
                Ctrl.Value = False
                Ctrl.Enabled = True
                Ctrl.Visible = True
            Case "TextBox"
                Ctrl.Value = ""
        End Select
    Next Ctrl
EnableEvents = True
End Sub

et
Code: 
Private Sub TextCode_Change()
If Not EnableEvents Then Exit Sub
Dim Ctrl As Control
Dim Trouve As Range

    Set Trouve = Range("t_Noms[Code]").Find(Me.TextCode, lookat:=xlWhole)
    If Not Trouve Is Nothing Then Me.T_bx_Noms = Trouve.Offset(0, 1)
    
    With Range("t_Saisie").ListObject

        Set Trouve = .ListColumns("Code agent").Range.Find(Me.TextCode, lookat:=xlWhole)
        If Not Trouve Is Nothing Then
            Me.Tbx_DebMat.Value = Format(Trouve.Offset(0, 3), "hh:mm")
            Me.Tbx_FinMat.Value = Format(Trouve.Offset(0, 4), "hh:mm")
            Me.Tbx_DebAPM.Value = Format(Trouve.Offset(0, 5), "hh:mm")
            Me.Tbx_FinAPM.Value = Format(Trouve.Offset(0, 6), "hh:mm")
            Me.Tbx_DebSoir.Value = Format(Trouve.Offset(0, 7), "hh:mm")
            Me.Tbx_FinSoir.Value = Format(Trouve.Offset(0, 8), "hh:mm")
            Me.T_bx_Commentaire = Trouve.Offset(0, 9)
          
            For Each Ctrl In Me.Frame2.Controls
                If TypeName(Ctrl) = "TextBox" Then
                    If Left(Ctrl.Name, 4) = "Tbx_" Then
                        Nom = Replace(Ctrl.Name, "Tbx_", "")
                        Ctrl.Enabled = (Ctrl.Value = "")
                        Me.Frame2.Controls("Chk_" & Nom).Enabled = (Ctrl.Value = "")
                        Me.Frame2.Controls("Chk_" & Nom).Visible = (Ctrl.Value = "")
                    End If
                End If
            Next Ctrl
          
        End If

    End With
    
    If Me.Tbx_FinMat.Enabled = False Then
        Me.Chk_DebMat.Enabled = False
        Me.Chk_DebMat.BackColor = RGB(255, 0, 0)
    Else
        Me.Chk_DebMat.BackColor = RGB(160, 255, 255)
    End If
    
    If Me.Tbx_FinAPM.Enabled = False Then
        Me.Chk_DebAPM.Enabled = False
        Me.Chk_DebAPM.BackColor = RGB(255, 0, 0)
    Else
        Me.Chk_DebAPM.BackColor = RGB(160, 255, 255)
    End If
    
    If Me.Tbx_FinSoir.Enabled = False Then
        Me.Chk_DebSoir.Enabled = False
        Me.Chk_DebSoir.BackColor = RGB(255, 0, 0)
    Else
        Me.Chk_DebSoir.BackColor = RGB(160, 255, 255)
    End If
         Me.Lbx_Information.Caption = "Vous ne pouvez plus badger"
  
CalculerTotalJournée
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Formule si est vide
Réponses
9
Affichages
435
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
460
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
398
TooFatBoy
TooFatBoy
F
  • Résolu(e)
Microsoft 365 comptage de cellules
Réponses
3
Affichages
223
FRB78
F
D
  • Résolu(e)
Microsoft 365 Copier / coller données spécifiques documents txt vers Excel
Réponses
3
Affichages
553
Staple1600
Staple1600

Membres actuellement en ligne

5 membres et 76 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 587
Messages
2 110 985
Membres
111 000
dernier inscrit
Mouhamedw