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:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
vgendron

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
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
vgendron à dit:
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
Cliquez pour agrandir...
Merci beaucoup, ça fait ce que je souhaitais.
Je n'aurai jamais réussi à faire ça sans ton aide.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
vgendron à dit:
dans le code du bouton valider, il faut aussi remettre la date du jour
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
NONO14 à dit:
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
Cliquez pour agrandir...
tu peux mettre ca dans le premier case, quand tout est pointé
 
Vote positif 0 Vote négatif
vgendron

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
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
vgendron à dit:
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
Cliquez pour agrandir...
Waouh ! C'est super cool.
Je suis scotché de voir comment tu as pu réduire le code, chapeau bas Monsieur...👏
 
Vote positif 0 Vote négatif
N

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
 
Vote positif 0 Vote négatif
vgendron

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"
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
vgendron à dit:
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"
Cliquez pour agrandir...
Oui je m'en souviens, mais je l'ai effacé. Je vais regarder dans un ancien fichier si je l'ai toujours.
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Formule si est vide
Réponses
9
Affichages
448
Marvin57
M
F
  • Résolu(e)
XL 2013 Resultat en fonction de 3 conditions cumultatives
Réponses
2
Affichages
352
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
477
MilieBZH
M
HamoudaBA
  • Question
XL 2021 RESOLU recherchev vba sur autre feuille
Réponses
10
Affichages
787
HamoudaBA
HamoudaBA
C
  • Question
Microsoft 365 Formule Excel qui additionne la tarification quotidienne
Réponses
2
Affichages
189
TooFatBoy
TooFatBoy
D
  • Question
Microsoft 365 Excel fonction SI
Réponses
5
Affichages
416
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
416
TooFatBoy
TooFatBoy
F
  • Résolu(e)
Microsoft 365 comptage de cellules
Réponses
3
Affichages
239
FRB78
F
D
  • Résolu(e)
Microsoft 365 Copier / coller données spécifiques documents txt vers Excel
Réponses
3
Affichages
564
Staple1600
Staple1600

Membres actuellement en ligne

3 membres et 43 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 738
Messages
2 112 339
Membres
111 513
dernier inscrit
jeanmarty