Microsoft 365 Ecrire une formule de calcul en Vba Excel

NONO14 · 6 Septembre 2024

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="";""))))))))))

ChTi160 · 30 Septembre 2024

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 · 13 Septembre 2024

vgendron à dit:
c'est normal,
un label est fait pour montrer une info.. il n'est pas destiné à entrer en interaction avec l'utilisateur:
pas de clic, pas de selection, pas de modification.==> ces évènements n'existent pas

Je l'ai mis au niveau du TextCode_Change et ça fonctionne. En fait il ne reprend que les données déjà saisies, il ne fait pas de calcul immédiat.

Et bien non, il fait bien le calcul.

NONO14 · 13 Septembre 2024

Décidemment c'est la journée des galères (vendredi 13).
J'ai mis en place ce code qui me permet d'injecter les données du formulaire UfPointage vers la feuille "Saisie" - TS t_Saisie.
Cependant, il m'ajoute une ligne plutôt que de continuer à remplir les lignes déjà saisies si le code employé existe déjà. J'ai dû zapper quelque chose. Je commence à fatiguer.
Voici le code :

VB:

Private Sub Btx_Valide_Click()
Dim LastLine
Dim Ctrl As Control
  
    If Me.TextCode.Value = "" Then
        Me.Lbx_Information.Caption = "Merci de taper votre code"
    Exit Sub
    End If
    
   With Sheets("Saisie").ListObjects("t_Saisie")
   .ListRows.Add
   LastLine = .ListRows.Count
  
    .DataBodyRange(LastLine, 1) = Me.TextCode
    .DataBodyRange(LastLine, 2) = Me.Tbx_Noms
    .DataBodyRange(LastLine, 3) = Me.Txt_DateJour
    .DataBodyRange(LastLine, 4) = Me.Lbl_DebMat
    .DataBodyRange(LastLine, 5) = Me.Lbl_FinMat
    .DataBodyRange(LastLine, 6) = Me.Lbl_DebAPM
    .DataBodyRange(LastLine, 7) = Me.Lbl_FinAPM
    .DataBodyRange(LastLine, 8) = Me.Lbl_DebSoir
    .DataBodyRange(LastLine, 9) = Me.Lbl_FinSoir
    .DataBodyRange(LastLine, 10) = Me.Lbl_TotJour
    .DataBodyRange(LastLine, 11) = Me.Tbx_Commentaire
   End With
  
    For Each Ctrl In Frame2.Controls
        Select Case TypeName(Ctrl)
    Case "CheckBox"
Ctrl.Value = False
Ctrl.Enabled = True
Ctrl.Visible = True
    Case "Label"
Ctrl.Caption = ""
        End Select
Next Ctrl

Me.TextCode.Value = ""
Me.Tbx_Noms.Value = ""
Me.Tbx_Commentaire.Value = ""

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

End Sub

vgendron · 13 Septembre 2024

c'est normal.. à aucun moment tu ne regardes si la ligne existe déjà
il faudrait modifier pour avoir ca

VB:

with sheets("Saisie").listobjects("t_saisie")
    chercher ligne (un truc du genre set trouve=....)
    si not trouve is nothing then 'la ligne existe, il faut la compléter
       Ligne=trouve.row -.range.row
   sinon ' il s'agit d'une nouvelle ligne
      ligne=.listrows.add.index ' on ajoute une ligne et on note directement son index
   fin si
  
'on peut remplir la ligne
   .databodyrange(ligne,1)=...
...

end with

NONO14 · 13 Septembre 2024

vgendron à dit:

c'est normal.. à aucun moment tu ne regardes si la ligne existe déjà
il faudrait modifier pour avoir ca

VB:

with sheets("Saisie").listobjects("t_saisie")
    chercher ligne (un truc du genre set trouve=....)
    si not trouve is nothing then 'la ligne existe, il faut la compléter
       Ligne=trouve.row -.range.row
   sinon ' il s'agit d'une nouvelle ligne
      ligne=.listrows.add.index ' on ajoute une ligne et on note directement son index
   fin si
 
'on peut remplir la ligne
   .databodyrange(ligne,1)=...
...

end with

Oui c'est exact, c'est ce que j'étais entrain de me rendre compte. J'ai copié bêtement un code que j'avais sous le coude et voilà le résultat, quel tebé je suis.
Allez, je m'y remets.
Merci pour tes explications.

vgendron · 13 Septembre 2024

attention... une ligne qui existe déjà, c'est une ligne avec le meme NOM que celui sélectionné ET la même date du jour

ex: on est le 13/09, Paul Ochon fait sa saisie..
pas question de modifier la ligne de Paul Ochon du 11/09...

NONO14 · 13 Septembre 2024

vgendron à dit:
attention... une ligne qui existe déjà, c'est une ligne avec le meme NOM que celui sélectionné ET la même date du jour

ex: on est le 13/09, Paul Ochon fait sa saisie..
pas question de modifier la ligne de Paul Ochon du 11/09...

Oui c'est exact, il va donc falloir faire la recherche sur la date et sur le code agent, ça ce complique là.
Normalement, le tableau devrait être vidé tous les soirs, mais on ne sait jamais en cas d'oubli, il faut être prévoyant.
Merci de m'avoir interpellé sur ça.

NONO14 · 13 Septembre 2024

Il faudrait quelque chose comme ça mais avec 2 critères de recherche

VB:

    With Sheets("Saisie").ListObjects("t_Saisie")
        Set trouve = .ListColumns("Code agent").Range.Find(Me.TextCode, lookat:=xlWhole)
        If Not trouve Is Nothing Then
            Me.Tbx_Noms = trouve.Offset(0, 1)
        End If
    End With
Else
    With Sheets("Saisie").ListObjects("t_Saisie")
        Set trouve = .ListColumns("Code agent").Range.Find(Me.TextCode, lookat:=xlWhole)
        If Not trouve Is Nothing Then
            Me.Lbl_DebMat.Caption = Format(trouve.Offset(0, 3), "hh:mm")
            Me.Lbl_FinMat.Caption = Format(trouve.Offset(0, 4), "hh:mm")
            Me.Lbl_DebAPM.Caption = Format(trouve.Offset(0, 5), "hh:mm")
            Me.Lbl_FinAPM.Caption = Format(trouve.Offset(0, 6), "hh:mm")
            Me.Lbl_DebSoir.Caption = Format(trouve.Offset(0, 7), "hh:mm")
            Me.Lbl_FinSoir.Caption = Format(trouve.Offset(0, 8), "hh:mm")
            Me.Lbl_TotJour.Caption = Format(trouve.Offset(0, 9), "hh:mm")

vgendron · 13 Septembre 2024

non.. pas bien compliqué.. au lieu du trouve=find....
for i=1 to nbligne 'pour chaque ligne du tableau
si coloneNom= nom ET colonneDate=jour alors
ligne=i
sortie boucle
fin si
next i

NONO14 · 13 Septembre 2024

vgendron à dit:
non.. pas bien compliqué.. au lieu du trouve=find....
for i=1 to nbligne 'pour chaque ligne du tableau
si coloneNom= nom ET colonneDate=jour alors
ligne=i
sortie boucle
fin si
next i

Ok je vais essayer.
Merci pour tes explications

NONO14 · 13 Septembre 2024

Voilà j'ai essayé de faire ce code mais j'ai une incompatibilité de type sur la ligne :
"Set cellulecherchee = .ListColumns("Code agent") And .ListColumns("Date").DataBodyRange.Find(Me.TextCode.Value And Me.Txt_DateJour.Value, lookat:=xlWhole)"
Je n'arrive pas à trouver mon erreur.
Avez-vous une idée ?
Merci par avance

VB:

Private Sub Btx_Valide_Click()
Dim LastLine
Dim Ctrl As Control
Dim cellulecherchee As Range, ligne As Long, col As Long, valeur_cherchee As String
    
    If Me.TextCode.Value = "" Then
        Me.Lbx_Information.Caption = "Merci de taper votre code"
    Exit Sub
    End If
    
valeur_cherchee = Me.TextCode & Me.Txt_DateJour
    
    With Sheets("Saisie").ListObjects("t_Saisie")
    Set cellulecherchee = .ListColumns("Code agent") And .ListColumns("Date").DataBodyRange.Find(Me.TextCode.Value And Me.Txt_DateJour.Value, lookat:=xlWhole)

    If cellulecherchee Is Nothing Then
    .DataBodyRange(LastLine, 1) = Me.TextCode
    .DataBodyRange(LastLine, 2) = Me.Tbx_Noms
    .DataBodyRange(LastLine, 3) = Me.Txt_DateJour
    .DataBodyRange(LastLine, 4) = Me.Lbl_DebMat
    .DataBodyRange(LastLine, 5) = Me.Lbl_FinMat
    .DataBodyRange(LastLine, 6) = Me.Lbl_DebAPM
    .DataBodyRange(LastLine, 7) = Me.Lbl_FinAPM
    .DataBodyRange(LastLine, 8) = Me.Lbl_DebSoir
    .DataBodyRange(LastLine, 9) = Me.Lbl_FinSoir
    .DataBodyRange(LastLine, 10) = Me.Lbl_TotJour
    .DataBodyRange(LastLine, 11) = Me.Tbx_Commentaire
  
Else

vgendron · 13 Septembre 2024

non non.. c'est pas du tout comme ca qu'il faut s'y prendre
quand tu fais
set trouve=.range.find("cequoncherche",lookat:=xlwhole)
vba se charge de parcourir la range pour trouver "cequoncherche" et il te renvoie la cellule (c'est une range) dans trouve.. c'est pour ca que trouve est défini as range

la;. on a besoin de comparer DEUX colonnes à DEUX critères différents: le nom et la date
il faut donc parcourir "a la main" les lignes du tableau

VB:

With Sheets("Saisie").ListObjects("t_Saisie")
    Trouvé=false
    for i=1 to .listrows.count 'pour chaque ligne de la table
     if .ListColumns("Code agent").databodyrange(i)=Me.TextCode And .ListColumns("Date").DataBodyRange(i)=me.txt_DateJour then
            ligne=i
            Trouvé=true
            exit for
    end if
    if Not Trouvé then 'on a pas trouvé de ligne correspondante ==> il faut donc créer une nouvelle ligne
       ligne=.listrows.add.index 'on créé une nouvelle ligne et on note son index'
    end if
    
    'ici on sait où écrire les infos
        
    
    .DataBodyRange(ligne, 1) = Me.TextCode
    .DataBodyRange(ligne, 2) = Me.Tbx_Noms
    .DataBodyRange(ligne, 3) = Me.Txt_DateJour
    .DataBodyRange(ligne, 4) = Me.Lbl_DebMat
    .DataBodyRange(ligne, 5) = Me.Lbl_FinMat
    .DataBodyRange(ligne, 6) = Me.Lbl_DebAPM
    .DataBodyRange(ligne, 7) = Me.Lbl_FinAPM
    .DataBodyRange(ligne, 8) = Me.Lbl_DebSoir
    .DataBodyRange(ligne, 9) = Me.Lbl_FinSoir
    .DataBodyRange(ligne, 10) = Me.Lbl_TotJour
    .DataBodyRange(ligne, 11) = Me.Tbx_Commentaire
 end with

NONO14 · 13 Septembre 2024

Voici mon code complet. J'ai un message d'erreur "End With sans With" au niveau du End With.
Je suis vraiment désolé de ne pas trouver. Je vais reprendre demain à tête reposée.
Je termine une bricole et on verra plus tard.
Toutes mes excuses.

VB:

Private Sub Btx_Valide_Click()
Dim Ctrl As Control
    
    If Me.TextCode.Value = "" Then
        Me.Lbx_Information.Caption = "Merci de taper votre code"
    Exit Sub
    End If

With Sheets("Saisie").ListObjects("t_Saisie")
    Trouvé = False
    For I = 1 To .ListRows.Count 'pour chaque ligne de la table
     If .ListColumns("Code agent").DataBodyRange(I) = Me.TextCode And .ListColumns("Date").DataBodyRange(I) = Me.Txt_DateJour Then
            ligne = I
            Trouvé = True
            Exit For
    End If
    If Not Trouvé Then 'on a pas trouvé de ligne correspondante ==> il faut donc créer une nouvelle ligne
       ligne = .ListRows.Add.Index 'on créé une nouvelle ligne et on note son index'
    
    'ici on sait où écrire les infos
        
    
    .DataBodyRange(ligne, 1) = Me.TextCode
    .DataBodyRange(ligne, 2) = Me.Tbx_Noms
    .DataBodyRange(ligne, 3) = Me.Txt_DateJour
    .DataBodyRange(ligne, 4) = Me.Lbl_DebMat
    .DataBodyRange(ligne, 5) = Me.Lbl_FinMat
    .DataBodyRange(ligne, 6) = Me.Lbl_DebAPM
    .DataBodyRange(ligne, 7) = Me.Lbl_FinAPM
    .DataBodyRange(ligne, 8) = Me.Lbl_DebSoir
    .DataBodyRange(ligne, 9) = Me.Lbl_FinSoir
    .DataBodyRange(ligne, 10) = Me.Lbl_TotJour
    .DataBodyRange(ligne, 11) = Me.Tbx_Commentaire
 End With
  End If
    
    For Each Ctrl In Frame2.Controls
        Select Case TypeName(Ctrl)
    Case "CheckBox"
Ctrl.Value = False
Ctrl.Enabled = True
Ctrl.Visible = True
    Case "Label"
Ctrl.Caption = ""
        End Select
Next Ctrl

Me.TextCode.Value = ""
Me.Tbx_Noms.Value = ""
Me.Tbx_Commentaire.Value = ""

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

End Sub

vgendron · 13 Septembre 2024

il faut fermer les boucles et conditions au bon endroit
pour ne rien manquer.. astreints toi à utiliser l'indentation du code (décalage avec des tabulations)
c'est plus facile pour se repérer

VB:

Private Sub Btx_Valide_Click()

Dim Ctrl As Control

    If Me.TextCode.Value = "" Then
        me.Lbx_Information.Caption = "Merci de taper votre code"
        Exit Sub
    End If



With Sheets("Saisie").ListObjects("t_Saisie")
    Trouvé = False
    For I = 1 To .ListRows.Count 'pour chaque ligne de la table
       If .ListColumns("Code agent").DataBodyRange(I) = Me.TextCode And .ListColumns("Date").DataBodyRange(I) = Me.Txt_DateJour Then
            ligne = I
            Trouvé = True
            Exit For
        End If
    Next i
    If Not Trouvé Then 'on a pas trouvé de ligne correspondante ==> il faut donc créer une nouvelle ligne
       ligne = .ListRows.Add.Index 'on créé une nouvelle ligne et on note son index'
     end if
 
    'ici on sait où écrire les infos
    .DataBodyRange(ligne, 1) = Me.TextCode
    .DataBodyRange(ligne, 2) = Me.Tbx_Noms
    .DataBodyRange(ligne, 3) = Me.Txt_DateJour
    .DataBodyRange(ligne, 4) = Me.Lbl_DebMat
    .DataBodyRange(ligne, 5) = Me.Lbl_FinMat
    .DataBodyRange(ligne, 6) = Me.Lbl_DebAPM
    .DataBodyRange(ligne, 7) = Me.Lbl_FinAPM
    .DataBodyRange(ligne, 8) = Me.Lbl_DebSoir
    .DataBodyRange(ligne, 9) = Me.Lbl_FinSoir
    .DataBodyRange(ligne, 10) = Me.Lbl_TotJour
    .DataBodyRange(ligne, 11) = Me.Tbx_Commentaire
 End With

    For Each Ctrl In Frame2.Controls
        Select Case TypeName(Ctrl)
            Case "CheckBox"
                Ctrl.Value = False
                Ctrl.Enabled = True
                Ctrl.Visible = True
            Case "Label"
                Ctrl.Caption = ""
        End Select
    Next Ctrl
Me.TextCode.Value = ""
Me.Tbx_Noms.Value = ""
Me.Tbx_Commentaire.Value = ""
Me.Lbx_Information.Caption = "Veuillez saisir votre code employé(e)"

End Sub

TooFatBoy · 13 Septembre 2024

NONO14 à dit:
J'ai un message d'erreur "End With sans With" au niveau du End With.

D'où l'intérêt de l'indentation du code : ça permet de voir d'un coup d'œil s'il y a un problème de "boucle".

Le Next doit être sous le For, le End With sous le With, le Loop sous le Do, etc.
Et ce qui est à l'intérieur doit être décalé vers la droite.

Ainsi, si en dessous du With tu n'as pas ton End With, tu vois tout de suite qu'il y a un problème.

NONO14 · 14 Septembre 2024

Bonjour à toutes et à tous,
Je me suis remis sur mon projet et j'ai modifié quelques actions qui ne convenaient pas. J'ai remplacé tous labels de saisie d'heure par des TextBoxs ce qui sera plus facile pour le calcul du total d'heures jour, avec les Labels ça beuguait.
Cependant j'ai un message d'erreur dans le code suivant, j'ai certainement dû mal corrigé le code selon les modifications. "Objet spécifié introuvable". Cette erreur survient dés que je tape le code de l'employé (FAL221).
Sur cette ligne de code : " Me.Frame2.Controls("Chk_" & Nom).Enabled = (Ctrl.Value = "")"
Je n'arrive pas à trouver mon erreur.
Pouvez-vous m'aider s'il vous plait ?
Je vous en remercie par avance

VB:

Private Sub TextCode_Change()
Dim CtrlOb As Control
    With Sheets("Liste agents").ListObjects("t_Noms")
        Set trouve = .ListColumns("Code").Range.Find(Me.TextCode, lookat:=xlWhole)
        If Not trouve Is Nothing Then
            Me.Tbx_Noms = trouve.Offset(0, 1)
        End If
    End With
   
    With Sheets("Saisie").ListObjects("t_Saisie")
        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.Tbx_Commentaire = trouve.Offset(0, 9)
         
            For Each Ctrl In Me.Frame2.Controls
                If TypeName(Ctrl) = "TextBox" Then
                    Nom = Replace(Ctrl.Name, "Tbx_", "")
                    If Nom <> "Tbx_DateJour" Then
                        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
End Sub

Microsoft 365 Ecrire une formule de calcul en Vba Excel

NONO14

XLDnaute Impliqué

Pièces jointes

ChTi160

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

Pièces jointes

Discussions similaires