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

vgendron à dit:

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

Bonsoir vgendron,
Merci encore pour ton aide, merci également à TootFatBoy.
Le premier code "Annuler" fonctionne bien. Le deuxième, TextCode_Change, ne fonctionnait pas, alors j'ai supprimé ce bout "If Not EnableEvents Then Exit Sub" et ça fonctionne. Par contre, je viens de m'apercevoir d'une erreur, et là c'est de ma faute, c'est que lorsque l'on tape le code de l'employé(e) il ne prend pas en compte la date du jour. Par exemple, dans mon tableau, si l'on tape FAL221 (Paul AUCHON) il rapatrie les données enregistrées hier dimanche. Je vais donc modifier cette partie en espérant ne pas faire de bêtise.
Je vais me baser sur la recherche du nom, ça doit être le même principe.

NONO14 · 16 Septembre 2024

TooFatBoy à dit:
Est-ce une demande d'aide ?

ps : n'hésite pas utiliser une indentation correcte pour une meilleure lisibilité de ton code.

Oui, c'était une demande d'aide. Désolé de ne pas l'avoir précisé.
C'est quoi l'indentation ?? Je ne sais pas ce que c'est et comment ça fonctionne.

TooFatBoy · 16 Septembre 2024

NONO14 à dit:
C'est quoi l'indentation ?? Je ne sais pas ce que c'est et comment ça fonctionne.

C'est la mise en page de ton code .

Par exemple, décaler vers la droite tout ce qui est à l'intérieur d'une boucle FOR ... NEXT de façon à ce que le NEXT se retrouve sous le FOR.
Ca permet de voir en un coup d'oeil si on n'a pas oublié une fin de boucle ou un END IF ou autre.

NONO14 · 16 Septembre 2024

TooFatBoy à dit:
C'est la mise en page de ton code .

Par exemple, décaler vers la droite tout ce qui est à l'intérieur d'une boucle FOR ... NEXT de façon à ce que le NEXT se retrouve sous le FOR.
Ca permet de voir en un coup d'oeil si on n'a pas oublié une fin de boucle ou un END IF ou autre.

Ah ok, je vais m'y appliquer...

NONO14 · 16 Septembre 2024

J'ai écrit ce bout de code dans TextCode_Change que j'interprète comme "Je recherche dans le tableau "t_Saisie" la colonne "Date", si elle correspond à la date du jour inscrite dans le formulaire alors".
Mais apparemment ça ne fonctionne pas. J'ai du me planter quelque part... Je n'ai pas mis le code en entier parce que je pense que c'est uniquement cette partie qui est foireuse.
Voyez-vous mon erreur ?
Merci pour votre éclairage.

VB:

Private Sub TextCode_Change()

Dim Ctrl As Control
Dim Trouve As Range
Dim Trouve2 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)
    
    Set Trouve2 = Range("t_Saisie[Date]").Find(Me.T_bx_DateJour, lookat:=xlWhole) 'recherche la date dans le tableau
    If Trouve2 = Me.T_bx_DateJour Then 'si la date est égale à la date du jour dans le formulaire alors

TooFatBoy · 16 Septembre 2024

Les dates dans ton tableau sont des nombres interprétés comme des dates par Excel.
Une TextBox contient... du texte.

Pas sûr que ça marche, mais essaye CDate(Me.T_bx_DateJour) pour chercher une date.

NONO14 · 16 Septembre 2024

TooFatBoy à dit:
Les dates dans ton tableau sont des nombres interprétés comme des dates par Excel.
Une TextBox contient... du texte.

Pas sûr que ça marche, mais essaye CDate(Me.T_bx_DateJour) pour chercher une date.

Non ça ne fonctionne pas. Je continue à chercher de mon côté. J'ai dû passé à côté de quelque chose....

NONO14 · 16 Septembre 2024

TooFatBoy à dit:
Les dates dans ton tableau sont des nombres interprétés comme des dates par Excel.
Une TextBox contient... du texte.

Pas sûr que ça marche, mais essaye CDate(Me.T_bx_DateJour) pour chercher une date.

Dans les deux cas c'est au format dddd dd mmm yyyy

TooFatBoy · 16 Septembre 2024

Au temp pour moi : je viens de regarder ton fichier et, je ne sais pas pourquoi, mais les dates dans ton tableau sont en fait du texte et non des dates.

Ceci dit, du coup la date est bien trouvée.

NONO14 · 16 Septembre 2024

Je verrai ça demain.
Merci à vous deux de m'avoir encore aidé.
Demain sera un autre jour...
Bonne fin de soirée

vgendron · 16 Septembre 2024

VB:

Set Trouve = Range("t_Noms[Code]").Find(cdate(Me.TextCode), lookin:=xlValues)

vgendron · 17 Septembre 2024

Hello
il faudrait que tu postes ta dernière version qui inclue toutes les modifs qui ont été apportées depuis le début..
parce que je viens de regarder ton fichier PointHeure6.xlsm
j'ai l'impression qu'il manque des choses
par exemple ta macro sur le combobox_change ==la partie qui sauvegarde n'a aucune chance de fonctionner correctement...

NONO14 · 17 Septembre 2024

Bonjour à toutes et à tous
Cette version est la dernière, il ne faut pas tenir compte du code de sauvegarde car il n'est pas fonctionnel. Je l'ai gardé pour m'en inspirer pour la suite. Je ne suis pas sur mon écran actuellement, je vous réponds de mon téléphone.
Je vais tester vos propositions dès que possible.

NONO14 · 17 Septembre 2024

NONO14 à dit:
Bonjour à toutes et à tous
Cette version est la dernière, il ne faut pas tenir compte du code de sauvegarde car il n'est pas fonctionnel. Je l'ai gardé pour m'en inspirer pour la suite. Je ne suis pas sur mon écran actuellement, je vous réponds de mon téléphone.
Je vais tester vos propositions dès que possible.

Je dois de temps en temps m'absenter pour raison médicale.
Toutes mes excuses

TooFatBoy · 17 Septembre 2024

NONO14 à dit:
Cette version est la dernière, il ne faut pas tenir compte du code de sauvegarde car il n'est pas fonctionnel.

C'est pas faux...

vgendron à dit:
il faudrait que tu postes ta dernière version

C'est exact.

Microsoft 365 Ecrire une formule de calcul en Vba Excel

NONO14

XLDnaute Impliqué

Pièces jointes

ChTi160

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Discussions similaires