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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Enrichi (BBcode): 
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
Juste une remarque qui ne répond pas à ta question, mais à mon avis ton test ne sert à rien.
 
Dernière édition:
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Enrichi (BBcode): 
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
Juste une remarque qui ne répond pas à ta question, mais à mon avis ton test ne sert à rien.
Cliquez pour agrandir...
Bonsoir TootFatBoy,
Ah bon ? Ce que je cherche à faire, c'est de vérifier si le code et la date du jour existe déjà dans le tableau("t_Saisie"), si oui, on récupére les données existantes dans le formulaire, les Textbox remplies ne sont plus modifiables, par contre on peut compléter le formulaire par un nouveau pointage. Je pensais que mon code faisait ça ?
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
NONO14 à dit:
Je n'arrive pas à trouver mon erreur.
Cliquez pour agrandir...
Elle est là :
NONO14 à dit:
J'ai remplacé tous labels de saisie d'heure par des TextBoxs
Cliquez pour agrandir...
Le code, qui avant ne s'appliquait qu'aux TextBox de l'époque, maintenant s'applique aussi aux anciens Label qui sont maintenant des TextBox.
Il faut donc modifier ton code en conséquence.
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Une proposition, à tout hasard... :confused:

VB: 
Private Sub TextCode_Change()
'
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

End Sub
 

Pièces jointes

  • PointHeure5.xlsm
    694.7 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Comment ça "ah bon ?" ??? :oops:

Dans la variable Nom, tu enlèves "Tbx_" et en suite tu testes si la variable Nom est égale à une valeur contenant "Tbx_".
Y a pas comme un truc qui te titille et t'interpelle ? ;)
Cliquez pour agrandir...
Toutes mes TextBoxs de la Frame2 commencent par "Tbx_". Je vais suivre ton conseil est remplacé mes 6 Textbox de pointage
Désolé, je n'avais pas vu ta proposition de code. Je vais la tester.
Merci pour ton aide, je comprends que cela ne doit pas être aisé face à un bourrin comme moi
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
J'ai corrigé ce petit bout "Me.T_bx_Noms = Trouve.Offset(0, 1)" par "Me.Tbx_Noms" et celui-ci "Me.T_bx_Commentaire = Trouve.Offset(0, 9)" par "Tbx_Commentaires" et ça fonctionne. Je vais me pencher sur ton code afin de mieux le cerner.
Je fais de mon mieux pour régler mes problèmes, mais parfois (souvent), mon cerveau fonctionne au ralenti.
Je m'en excuse sincérement.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Une proposition, à tout hasard... :confused:

VB: 
Private Sub TextCode_Change()
'
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
                    Nom = Replace(Ctrl.Name, "Tbx_", "")
'                    If Nom <> "Tbx_DateJour" Then
                    If Left(Ctrl.Name, 4) = "tbx_" 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
Cliquez pour agrandir...
Ton code rapatrie bien les données, par contre, les TextBox déjà remplies sont modifiables et ça ne doit pas être les cas, et les CheckBoxs devant les TextBoxs remplies doivent être non visibles ou Enabled= False afin de ne pas être réutilisées si des données sont déjà existantes.
Je vais regarder ça.
 
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