Microsoft 365 Ecrire une formule de calcul en Vba Excel

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
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 ...

NONO14

XLDnaute Impliqué
pour les différents tests if que tu as faits
la question est: tu vérifies quoi? = tu autorises quoi?

ce que je pense:
on ne peut pas pointer un horaire (début ou fin) entre deux pointages déjà faits... correct?
ex:
Début matin pointé
Fin Matin "oublié
Début APM pointé

==> nouveau pointage: ne peut pas être fin matin, mais uniquement tout ce qui est après le dernier pointage (Début APM)

dans ce cas.. il "suffirait" de trouver le dernier pointage effectué puis laisser enable les pointages suivants et désactiver les précédents
Oui c'est tout à fait ça. Cependant dans ma petite tête j'ai essayé d'imaginer tous les scénarios et ça donne ça et c'est très long. Je ne sais pas faire autrement. Je vais relire tout ça pour voir s'il n'y a pas des doublons.
VB:
If Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" Then
            Me.Chk_DebMat.Visible = False
            Me.Chk_FinMat.Visible = False
                Me.Lbx_Information.Caption = "Vous ne pouvez plus badger pour le matin"
          End If
          
          If Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebAPM.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" Then
            Me.Chk_DebMat.Visible = False
            Me.Chk_FinMat.Visible = False
            Me.Chk_DebAPM.Visible = False
                Me.Lbx_Information.Caption = "Vous ne pouvez plus badger pour le matin"
          End If
          
          If Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value = "" Then
            Me.Chk_DebMat.Visible = False
            Me.Chk_FinMat.Visible = False
            Me.Chk_DebAPM.Visible = False
            Me.Chk_FinAPM.Visible = False
                Me.Lbx_Information.Caption = "Vous ne pouvez plus badger pour l'après-midi"
          End If
          
          If Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value = "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value = "" Then
            Me.Chk_DebMat.Visible = False
            Me.Chk_FinMat.Visible = False
            Me.Chk_DebAPM.Visible = False
            Me.Chk_FinAPM.Visible = False
                Me.Lbx_Information.Caption = "Vous ne pouvez badger que pour le soir"
          End If
            
          If Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value <> "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value <> "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value = "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value = "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value = "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" _
          Or Me.Tbx_DebMat.Value <> "" And Me.Tbx_FinMat.Value = "" And Me.Tbx_DebAPM.Value <> "" And Me.Tbx_FinAPM.Value <> "" And Me.Tbx_DebSoir.Value = "" And Me.Tbx_FinSoir.Value <> "" Then
                Me.Lbx_Information.Caption = "Vous ne pouvez plus badger"
          End If
          
                If Me.Lbx_Information.Caption = "Vous ne pouvez plus badger" Then
                        For Each Ctrl3 In Me.Frame2.Controls
                            If TypeName(Ctrl3) = "CheckBox" Then
                                If Left(Ctrl3.Name, 4) = "Chk_" Then
                                Nom = Replace(Ctrl3.Name, "Chk_", "")
                                Ctrl3.Visible = False
                                End If
                            End If
                        Next Ctrl3
                            Me.Btx_Valide.Enabled = False
                End If
                    
    CalculerTotalJournée
End Sub
 

vgendron

XLDnaute Barbatruc
Ca donnerait ca

une nouvelle fonction à mettre dans le module du formulaire (avec le reste)
VB:
Function LastPointé() As String 'cette fonction retourne le nom du dernier textbox pointé
     With Me
        If .Tbx_FinSoir <> "" Then LastPointé = .Tbx_FinSoir.Name: Exit Function
        If .Tbx_DebSoir <> "" Then LastPointé = .Tbx_DebSoir.Name: Exit Function
        
        If .Tbx_FinAPM <> "" Then LastPointé = .Tbx_FinAPM.Name: Exit Function
        If .Tbx_DebAPM <> "" Then LastPointé = .Tbx_DebAPM.Name: Exit Function
        
        If .Tbx_FinMat <> "" Then LastPointé = .Tbx_FinMat.Name: Exit Function
        If .Tbx_DebMat <> "" Then LastPointé = .Tbx_DebMat.Name: Exit Function
     End With
End Function

et une nouveau code pour le textcode_change
peut etre plus long en terme de ligne de code, mais plus lisible..?
Code:
Private Sub TextCode_Change()
Dim Ctrl As Control
Dim Ctrl2 As Control
Dim Trouvé As Boolean
  
    Me.TextCode.Text = UCase(Me.TextCode)
  
    If Not EnableEvents Then Exit Sub
    'on cherche le nom associé au code dans la TS "t_Noms"
    With Sheets("Liste agents").ListObjects("t_Noms")
        Set Trouve = .ListColumns(1).Range.Find(Me.TextCode, lookat:=xlWhole)
        If Not Trouve Is Nothing Then
            Me.T_bx_Noms = Trouve.Offset(0, 1)
        Else
            Me.T_bx_Noms = ""
        End If
    End With
        
    'on cherche dans la TS t_Saisie la ligne qui correspond au code ET à la date du jour
    With Sheets("Saisie").ListObjects("t_Saisie")
        Trouvé = False
        For I = 1 To .ListRows.Count
            If .ListColumns("Code agent").DataBodyRange(I) = Me.TextCode And .ListColumns("Date").DataBodyRange(I) = Me.T_bx_DateJour Then
                lig = I
                Trouvé = True
                Exit For
            End If
        Next I
            
        If Not Trouvé Then Exit Sub 'pas de ligne correspondante ==> l'employé n'a jamais rien saisi pour cette journée
            
        'on charge les horaires déjà saisies pour la date du jour
        Me.T_bx_Noms = .DataBodyRange(I, 2)
        Me.Tbx_DebMat.Value = Format(.DataBodyRange(I, 4), "hh:mm")
        Me.Tbx_FinMat.Value = Format(.DataBodyRange(I, 5), "hh:mm")
        Me.Tbx_DebAPM.Value = Format(.DataBodyRange(I, 6), "hh:mm")
        Me.Tbx_FinAPM.Value = Format(.DataBodyRange(I, 7), "hh:mm")
        Me.Tbx_DebSoir.Value = Format(.DataBodyRange(I, 8), "hh:mm")
        Me.Tbx_FinSoir.Value = Format(.DataBodyRange(I, 9), "hh:mm")
        Me.T_bx_Commentaire = .DataBodyRange(I, 11)
            
        'on rend tous les checkbox disable et invisible
        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 = False ' (Ctrl.Value = "")
                    Me.Frame2.Controls("Chk_" & Nom).Enabled = False '(Ctrl.Value = "")
                    Me.Frame2.Controls("Chk_" & Nom).Visible = False '(Ctrl.Value = "")
                End If
            End If
        Next Ctrl
    End With

    Select Case LastPointé
        Case "Tbx_FinSoir"
            'tout est pointé==> on garde tout masqué et disable
        Case "Tbx_DebSoir"
            Me.Tbx_FinSoir.Enabled = True
            
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_FinSoir.Visible = True
        
        Case "Tbx_FinAPM"
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            
        Case "Tbx_DebAPM"
             Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
    
    
        Case "Tbx_FinMat"
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            Me.Tbx_DebAPM.Enabled = True
            
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_DebAPM.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
            Me.Chk_DebAPM.Visible = True
        
        Case "Tbx_DebMat"
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            Me.Tbx_DebAPM.Enabled = True
            Me.Tbx_FinMat.Enabled = True
            
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_DebAPM.Enabled = True
            Me.Chk_FinMat.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
            Me.Chk_DebAPM.Visible = True
            Me.Chk_FinMat.Visible = True
            
        Case Else
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            Me.Tbx_DebAPM.Enabled = True
            Me.Tbx_FinMat.Enabled = True
            Me.Tbx_DebMat.Enabled = True
            
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_DebAPM.Enabled = True
            Me.Chk_FinMat.Enabled = True
            Me.Chk_DebMat.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
            Me.Chk_DebAPM.Visible = True
            Me.Chk_FinMat.Visible = True
            Me.Chk_DebMat.Visible = True
    End Select
    CalculerTotalJournée
End Sub
 

NONO14

XLDnaute Impliqué
Ca donnerait ca

une nouvelle fonction à mettre dans le module du formulaire (avec le reste)
VB:
Function LastPointé() As String 'cette fonction retourne le nom du dernier textbox pointé
     With Me
        If .Tbx_FinSoir <> "" Then LastPointé = .Tbx_FinSoir.Name: Exit Function
        If .Tbx_DebSoir <> "" Then LastPointé = .Tbx_DebSoir.Name: Exit Function
       
        If .Tbx_FinAPM <> "" Then LastPointé = .Tbx_FinAPM.Name: Exit Function
        If .Tbx_DebAPM <> "" Then LastPointé = .Tbx_DebAPM.Name: Exit Function
       
        If .Tbx_FinMat <> "" Then LastPointé = .Tbx_FinMat.Name: Exit Function
        If .Tbx_DebMat <> "" Then LastPointé = .Tbx_DebMat.Name: Exit Function
     End With
End Function

et une nouveau code pour le textcode_change
peut etre plus long en terme de ligne de code, mais plus lisible..?
Code:
Private Sub TextCode_Change()
Dim Ctrl As Control
Dim Ctrl2 As Control
Dim Trouvé As Boolean
 
    Me.TextCode.Text = UCase(Me.TextCode)
 
    If Not EnableEvents Then Exit Sub
    'on cherche le nom associé au code dans la TS "t_Noms"
    With Sheets("Liste agents").ListObjects("t_Noms")
        Set Trouve = .ListColumns(1).Range.Find(Me.TextCode, lookat:=xlWhole)
        If Not Trouve Is Nothing Then
            Me.T_bx_Noms = Trouve.Offset(0, 1)
        Else
            Me.T_bx_Noms = ""
        End If
    End With
       
    'on cherche dans la TS t_Saisie la ligne qui correspond au code ET à la date du jour
    With Sheets("Saisie").ListObjects("t_Saisie")
        Trouvé = False
        For I = 1 To .ListRows.Count
            If .ListColumns("Code agent").DataBodyRange(I) = Me.TextCode And .ListColumns("Date").DataBodyRange(I) = Me.T_bx_DateJour Then
                lig = I
                Trouvé = True
                Exit For
            End If
        Next I
           
        If Not Trouvé Then Exit Sub 'pas de ligne correspondante ==> l'employé n'a jamais rien saisi pour cette journée
           
        'on charge les horaires déjà saisies pour la date du jour
        Me.T_bx_Noms = .DataBodyRange(I, 2)
        Me.Tbx_DebMat.Value = Format(.DataBodyRange(I, 4), "hh:mm")
        Me.Tbx_FinMat.Value = Format(.DataBodyRange(I, 5), "hh:mm")
        Me.Tbx_DebAPM.Value = Format(.DataBodyRange(I, 6), "hh:mm")
        Me.Tbx_FinAPM.Value = Format(.DataBodyRange(I, 7), "hh:mm")
        Me.Tbx_DebSoir.Value = Format(.DataBodyRange(I, 8), "hh:mm")
        Me.Tbx_FinSoir.Value = Format(.DataBodyRange(I, 9), "hh:mm")
        Me.T_bx_Commentaire = .DataBodyRange(I, 11)
           
        'on rend tous les checkbox disable et invisible
        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 = False ' (Ctrl.Value = "")
                    Me.Frame2.Controls("Chk_" & Nom).Enabled = False '(Ctrl.Value = "")
                    Me.Frame2.Controls("Chk_" & Nom).Visible = False '(Ctrl.Value = "")
                End If
            End If
        Next Ctrl
    End With

    Select Case LastPointé
        Case "Tbx_FinSoir"
            'tout est pointé==> on garde tout masqué et disable
        Case "Tbx_DebSoir"
            Me.Tbx_FinSoir.Enabled = True
           
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_FinSoir.Visible = True
       
        Case "Tbx_FinAPM"
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
           
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
           
        Case "Tbx_DebAPM"
             Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
           
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
   
   
        Case "Tbx_FinMat"
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            Me.Tbx_DebAPM.Enabled = True
           
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_DebAPM.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
            Me.Chk_DebAPM.Visible = True
       
        Case "Tbx_DebMat"
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            Me.Tbx_DebAPM.Enabled = True
            Me.Tbx_FinMat.Enabled = True
           
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_DebAPM.Enabled = True
            Me.Chk_FinMat.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
            Me.Chk_DebAPM.Visible = True
            Me.Chk_FinMat.Visible = True
           
        Case Else
            Me.Tbx_FinSoir.Enabled = True
            Me.Tbx_DebSoir.Enabled = True
            Me.Tbx_FinAPM.Enabled = True
            Me.Tbx_DebAPM.Enabled = True
            Me.Tbx_FinMat.Enabled = True
            Me.Tbx_DebMat.Enabled = True
           
            Me.Chk_FinSoir.Enabled = True
            Me.Chk_DebSoir.Enabled = True
            Me.ChK_FinAPM.Enabled = True
            Me.Chk_DebAPM.Enabled = True
            Me.Chk_FinMat.Enabled = True
            Me.Chk_DebMat.Enabled = True
            Me.Chk_FinSoir.Visible = True
            Me.Chk_DebSoir.Visible = True
            Me.ChK_FinAPM.Visible = True
            Me.Chk_DebAPM.Visible = True
            Me.Chk_FinMat.Visible = True
            Me.Chk_DebMat.Visible = True
    End Select
    CalculerTotalJournée
End Sub
Merci beaucoup, ça fait ce que je souhaitais.
Je n'aurai jamais réussi à faire ça sans ton aide.
 

NONO14

XLDnaute Impliqué
dans le code du bouton valider, il faut aussi remettre la date du jour
Ok, sur le même principe que le bouton "Annuler" ?
Sinon, dans le code TextCode_Change, serait-il possible de rendre inactif le bouton"Valider" si il n'y a plus de possibilités de pointage et mettre un message dans le Label "Plus de pointages possibles".
Si c'est trop compliqué, ce n'est pas grave.
Encore mille mercis
 

vgendron

XLDnaute Barbatruc
Ok, sur le même principe que le bouton "Annuler" ?
Sinon, dans le code TextCode_Change, serait-il possible de rendre inactif le bouton"Valider" si il n'y a plus de possibilités de pointage et mettre un message dans le Label "Plus de pointages possibles".
Si c'est trop compliqué, ce n'est pas grave.
Encore mille mercis
tu peux mettre ca dans le premier case, quand tout est pointé
 

vgendron

XLDnaute Barbatruc
regarde la PJ
j'ai amélioré le code en le raccourcissant

1) je déclare en public un array "ListTbx"
2) je charge cet array avec la liste des 6 Tbx de pointage: DebMat, FinMat....
3) j'ai modifié la fonction LastPointage: avec juste une boucle
4) j'ai modifie le code du textCode_change
au lieu du très long select case, il n'y a plus qu'une boucle

et j'ai ajouté la gestion du bouton "Valider" et du message si plus de pointage à faire
 

Pièces jointes

  • PointHeure9.xlsm
    657.4 KB · Affichages: 3

NONO14

XLDnaute Impliqué
regarde la PJ
j'ai amélioré le code en le raccourcissant

1) je déclare en public un array "ListTbx"
2) je charge cet array avec la liste des 6 Tbx de pointage: DebMat, FinMat....
3) j'ai modifié la fonction LastPointage: avec juste une boucle
4) j'ai modifie le code du textCode_change
au lieu du très long select case, il n'y a plus qu'une boucle

et j'ai ajouté la gestion du bouton "Valider" et du message si plus de pointage à faire
Waouh ! C'est super cool.
Je suis scotché de voir comment tu as pu réduire le code, chapeau bas Monsieur...👏
 

NONO14

XLDnaute Impliqué
Maintenant, je vais m'attaquer la partie de l'application concernant les items de la ComboBox de la feuille "Saisie".
Quelle serait la manière la plus judicieuse d'opérer ?
Je pensais le faire par bloc selon le choix, mais je pressent que cela ne va pas convenir.
Pourriez-vous m'aider pour ce premier code, je m'en inspirerai pour les autres.
Je vous en remercie par avance
VB:
        Case "Enregistrer un(e) employé(e)"
            'Demande de Mot de Passe = Admin01
            'UfGestTemps.Show
            'Mettre le focus sur la page (0) du formulaire
            'Sheets ("Liste agents").activate
            'La feuille est déverrouillée pour la saisie et reverrouillée
            'La Combo revient à zéro
 

vgendron

XLDnaute Barbatruc
Dans une version antérieure, j'avais mis ceci

VB:
Private Sub ComboMenus_Change() 'à revoir
Dim DerLig, DerLigne, DerLigne2 As Long
Dim Name, CodAg, Com As String
Dim Jour2 As Date, Heure1 As Date, Heure2 As Date, Heure3 As Date, Heure4 As Date, Heure5 As Date, Heure6 As Date
Dim Ctrl

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Select Case ComboMenus
        Case "Enregistrer le planning"
            UfGestTemps.Show
            
        Case "Modifier une saisie de pointage"
            Load UfMDP
            UfMDP.Show
            
        Case "Sauvegarder les pointages"
            SauvegarderPointages
            
        Case "Modifier une saise de pointage"
            MsgBox "Pas de code associé"
            
        Case "Modifier le tableau récapitulatif"
            MsgBox "Pas de code associé"
            
        Case "Enresitrer un(e) employé(e)"
            MsgBox "Pas de code associé"
            
        Case "Modifier le planning"
            MsgBox "Pas de code associé"
            
        Case Else
            GoTo sortie
    End Select
    
sortie:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

il vaut mieux faire appel à une macro spécifique pour chaque cas
ex de "SauvegarderPointages" pour le cas "Sauvegarder les pointage"
 

NONO14

XLDnaute Impliqué
Dans une version antérieure, j'avais mis ceci

VB:
Private Sub ComboMenus_Change() 'à revoir
Dim DerLig, DerLigne, DerLigne2 As Long
Dim Name, CodAg, Com As String
Dim Jour2 As Date, Heure1 As Date, Heure2 As Date, Heure3 As Date, Heure4 As Date, Heure5 As Date, Heure6 As Date
Dim Ctrl

    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    Select Case ComboMenus
        Case "Enregistrer le planning"
            UfGestTemps.Show
           
        Case "Modifier une saisie de pointage"
            Load UfMDP
            UfMDP.Show
           
        Case "Sauvegarder les pointages"
            SauvegarderPointages
           
        Case "Modifier une saise de pointage"
            MsgBox "Pas de code associé"
           
        Case "Modifier le tableau récapitulatif"
            MsgBox "Pas de code associé"
           
        Case "Enresitrer un(e) employé(e)"
            MsgBox "Pas de code associé"
           
        Case "Modifier le planning"
            MsgBox "Pas de code associé"
           
        Case Else
            GoTo sortie
    End Select
   
sortie:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

il vaut mieux faire appel à une macro spécifique pour chaque cas
ex de "SauvegarderPointages" pour le cas "Sauvegarder les pointage"
Oui je m'en souviens, mais je l'ai effacé. Je vais regarder dans un ancien fichier si je l'ai toujours.
 

Discussions similaires

Réponses
9
Affichages
436
Réponses
5
Affichages
406
Réponses
3
Affichages
224

Statistiques des forums

Discussions
314 626
Messages
2 111 287
Membres
111 091
dernier inscrit
ISSAKA