Microsoft 365 Ecrire une formule de calcul en Vba Excel

N

NONO14

XLDnaute Occasionnel
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: 13
Dernière édition:
Solution
vgendron
Bonjour
tu dis ne pas vouloir protéger les colonnes..et pourtant tu postes un fichier protégé...

pour inscrire une formule dans une cellule J2 par VBA, voici ma méthode
1) créer une variable qui contient la formule en Anglais
FormuleJ="=if(A2="""",""""if(A2<>""""................)"
en anglais veut dire: les fonctions sont écrites dans la version Anglaise ==> Si==>IF, et==> And....
les ; sont remplacés par des ,
les " sont remplacés par ""

2) inscrire la formule
range("J2").formula=formuleJ

3) pour étirer la formule: autofill
Trier par date Trier par votes
N

NONO14

XLDnaute Occasionnel
Bonjour à toutes et à tous,
J'ai avancé dans mon projet mais j'aurai besoin de votre aide pour simplifier un code.
Celui-ci se trouve dans UfPointage et TextCode_Change, il y a 6 fois ce genre de code que je souhaiterai simplifier.
Pouvez-vous m'aiguiller s'il vous plait ?
J'ai essayé d'utiliser le 2ème code, en modifiant les controls, mais je n'arrive pas à mettre les conditions.
Merci par avance
VB: 
f Me.Lbl_DebMat.Caption <> "" Then
    Me.Chk_DebMat.Enabled = False
    Me.Chk_DebMat.Visible = False
    Me.Lbl_DebMat.Enabled = False
    End If
Code: 
Private Sub Btx_Annul_Click()
Dim Ctrl As Control
    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
 

Pièces jointes

  • PointHeure5.xlsm
    742.6 KB · Affichages: 2
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Hello

essaie ceci
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.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.Tbx_Commentaire = trouve.Offset(0, 9)
           
            For Each Ctrl In Me.Frame2.Controls
                If TypeName(Ctrl) = "Label" Then
                    Nom = Replace(Ctrl.Name, "Lbl_", "")
                    If Nom <> "TotJour" Then 'il s'agit aussi d'un label, mais pas concerné
                        Ctrl.Enabled = (Ctrl.Caption = "")
                        Me.Frame2.Controls("Chk_" & Nom).Enabled = (Ctrl.Caption = "")
                        Me.Frame2.Controls("Chk_" & Nom).Visible = (Ctrl.Caption = "")
                    End If
                End If
            Next Ctrl
           
'            Me.Chk_DebMat.Enabled = (Me.Lbl_DebMat.Caption = "")
'            Me.Chk_DebMat.Visible = (Me.Lbl_DebMat.Caption = "")
'            Me.Lbl_DebMat.Enabled = (Me.Lbl_DebMat.Caption = "")
'
'            Me.Chk_DebAPM.Enabled = (Me.Lbl_DebAPM.Caption = "")
'            Me.Chk_DebAPM.Visible = (Me.Lbl_DebAPM.Caption = "")
'            Me.Lbl_DebAPM.Enabled = (Me.Lbl_DebAPM.Caption = "")
'
'            Me.Chk_DebSoir.Enabled = (Me.Lbl_DebSoir.Caption = "")
'            Me.Chk_DebSoir.Visible = (Me.Lbl_DebSoir.Caption = "")
'            Me.Lbl_DebSoir.Enabled = (Me.Lbl_DebSoir.Caption = "")
'
'            Me.Chk_FinMat.Enabled = (Me.Lbl_FinMat.Caption = "")
'            Me.Chk_FinMat.Visible = (Me.Lbl_FinMat.Caption = "")
'            Me.Lbl_FinMat.Enabled = (Me.Lbl_FinMat.Caption = "")
'
'            Me.ChK_FinAPM.Enabled = (Me.Lbl_FinAPM.Caption = "")
'            Me.ChK_FinAPM.Visible = (Me.Lbl_FinAPM.Caption = "")
'            Me.Lbl_FinAPM.Enabled = (Me.Lbl_FinAPM.Caption = "")
'
'            Me.Chk_FinSoir.Enabled = (Me.Lbl_FinSoir.Caption = "")
'            Me.Chk_FinSoir.Visible = (Me.Lbl_FinSoir.Caption = "")
'            Me.Lbl_FinSoir.Enabled = (Me.Lbl_FinSoir.Caption = "")
        End If
    End With
End Sub

j'ai laissé en commentaire, les blocs de 3 lignes qui sont déjà une simplification de tes blocs "IF" associés aux 6 controls
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
vgendron à dit:
Hello

essaie ceci
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.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.Tbx_Commentaire = trouve.Offset(0, 9)
          
            For Each Ctrl In Me.Frame2.Controls
                If TypeName(Ctrl) = "Label" Then
                    Nom = Replace(Ctrl.Name, "Lbl_", "")
                    If Nom <> "TotJour" Then 'il s'agit aussi d'un label, mais pas concerné
                        Ctrl.Enabled = (Ctrl.Caption = "")
                        Me.Frame2.Controls("Chk_" & Nom).Enabled = (Ctrl.Caption = "")
                        Me.Frame2.Controls("Chk_" & Nom).Visible = (Ctrl.Caption = "")
                    End If
                End If
            Next Ctrl
          
'            Me.Chk_DebMat.Enabled = (Me.Lbl_DebMat.Caption = "")
'            Me.Chk_DebMat.Visible = (Me.Lbl_DebMat.Caption = "")
'            Me.Lbl_DebMat.Enabled = (Me.Lbl_DebMat.Caption = "")
'
'            Me.Chk_DebAPM.Enabled = (Me.Lbl_DebAPM.Caption = "")
'            Me.Chk_DebAPM.Visible = (Me.Lbl_DebAPM.Caption = "")
'            Me.Lbl_DebAPM.Enabled = (Me.Lbl_DebAPM.Caption = "")
'
'            Me.Chk_DebSoir.Enabled = (Me.Lbl_DebSoir.Caption = "")
'            Me.Chk_DebSoir.Visible = (Me.Lbl_DebSoir.Caption = "")
'            Me.Lbl_DebSoir.Enabled = (Me.Lbl_DebSoir.Caption = "")
'
'            Me.Chk_FinMat.Enabled = (Me.Lbl_FinMat.Caption = "")
'            Me.Chk_FinMat.Visible = (Me.Lbl_FinMat.Caption = "")
'            Me.Lbl_FinMat.Enabled = (Me.Lbl_FinMat.Caption = "")
'
'            Me.ChK_FinAPM.Enabled = (Me.Lbl_FinAPM.Caption = "")
'            Me.ChK_FinAPM.Visible = (Me.Lbl_FinAPM.Caption = "")
'            Me.Lbl_FinAPM.Enabled = (Me.Lbl_FinAPM.Caption = "")
'
'            Me.Chk_FinSoir.Enabled = (Me.Lbl_FinSoir.Caption = "")
'            Me.Chk_FinSoir.Visible = (Me.Lbl_FinSoir.Caption = "")
'            Me.Lbl_FinSoir.Enabled = (Me.Lbl_FinSoir.Caption = "")
        End If
    End With
End Sub

j'ai laissé en commentaire, les blocs de 3 lignes qui sont déjà une simplification de tes blocs "IF" associés aux 6 controls
Cliquez pour agrandir...
Bonjour,
Super ! ça fonctionne et c'est plus propre.
Merci beaucoup
Je continue le reste.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
Dans mon UserForm "UfPointage", je souhaite faire la soustraction de chaque période de pointage si le label n'est pas vide et qu'elle s'additionne dans le label Lbl_TotJour.
La formule doit donner ceci :
Lbl_FinMat - LblDebMat (si un des 2 labels n'est pas vide) + Lbl_FinAPM - Lbl_DebAPM (si pas vides) + Lbl_FinSoir - Lbl_DebSoir (si pas vides).
J'ai essayé de reprendre le code "Public Sub CalculerTotaux" dans le formulaire UfGestTemps mais je n'y arrive pas. Il n'y a pas de résultats.
Pouvez-vous m'expliquer la marche à suivre s'il vous plaît ?
Merci par avance
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Déjà.. la sub "CalculerTotaux" a été définie pour travailler sur le formulaire "UfGestTemps"
==> elle travaille donc avec des controles dudit formulaire

la.. tu veux faire la meme chose à peu près sur un autre formulaire
==> le plus simple est donc de créer une seconde sub
CalculerTotaux2()
et adapater avec les noms de control
supprimer la partie qui gère le jour.. puisque sur ton formulaire de pointage, il n'y a qu'UNE seule journée

Hello @TooFatBoy
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Nouvelle macro
VB: 
Public Sub CalculerTotalJournée()
Dim Total As Date
    If Me.Lbl_DebMat <> "" And Me.Lbl_FinMat <> "" Then
        Total = CDate(Me.Lbl_FinMat) - CDate(Me.Lbl_DebMat)
    End If
    If Me.Lbl_DebAPM <> "" And Me.Lbl_FinAPM <> "" Then
        Total = Total + CDate(Me.Lbl_FinAPM) - CDate(Me.Lbl_DebAPM)
    End If
    If Me.Lbl_DebSoir <> "" And Me.Lbl_FinSoir <> "" Then
        Total = Total + CDate(Me.Lbl_FinSoir) - CDate(Me.Lbl_DebSoir)
    End If
    
    Me.Lbl_TotJour = Format(Total, "hh:mm")
End Sub

mais maintenant.. il faut l'appeler
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
vgendron à dit:
Déjà.. la sub "CalculerTotaux" a été définie pour travailler sur le formulaire "UfGestTemps"
==> elle travaille donc avec des controles dudit formulaire

la.. tu veux faire la meme chose à peu près sur un autre formulaire
==> le plus simple est donc de créer une seconde sub
CalculerTotaux2()
et adapater avec les noms de control
supprimer la partie qui gère le jour.. puisque sur ton formulaire de pointage, il n'y a qu'UNE seule journée

Hello @TooFatBoy
Cliquez pour agrandir...
D'accord, je vais faire ça.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
vgendron à dit:
Nouvelle macro
VB: 
Public Sub CalculerTotalJournée()
Dim Total As Date
    If Me.Lbl_DebMat <> "" And Me.Lbl_FinMat <> "" Then
        Total = CDate(Me.Lbl_FinMat) - CDate(Me.Lbl_DebMat)
    End If
    If Me.Lbl_DebAPM <> "" And Me.Lbl_FinAPM <> "" Then
        Total = Total + CDate(Me.Lbl_FinAPM) - CDate(Me.Lbl_DebAPM)
    End If
    If Me.Lbl_DebSoir <> "" And Me.Lbl_FinSoir <> "" Then
        Total = Total + CDate(Me.Lbl_FinSoir) - CDate(Me.Lbl_DebSoir)
    End If
   
    Me.Lbl_TotJour = Format(Total, "hh:mm")
End Sub

mais maintenant.. il faut l'appeler
Cliquez pour agrandir...
Merci beaucoup. Je vais savoir faire pour l'appel de la Sub
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Formule si est vide
Réponses
9
Affichages
342
Marvin57
M
F
  • Résolu(e)
XL 2013 Resultat en fonction de 3 conditions cumultatives
Réponses
2
Affichages
288
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
360
MilieBZH
M
HamoudaBA
  • Question
XL 2021 RESOLU recherchev vba sur autre feuille
Réponses
10
Affichages
641
HamoudaBA
HamoudaBA
D
  • Question
Microsoft 365 Excel fonction SI
Réponses
5
Affichages
369
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
293
TooFatBoy
TooFatBoy
F
  • Résolu(e)
Microsoft 365 comptage de cellules
Réponses
3
Affichages
161
FRB78
F
D
  • Résolu(e)
Microsoft 365 Copier / coller données spécifiques documents txt vers Excel
Réponses
3
Affichages
531
Staple1600
Staple1600
C
  • Question
XL 2021 Formule: conditionner numéro de cellule a un numéro dans une autre cellule
Réponses
2
Affichages
194
Cousinhub
Cousinhub

Membres actuellement en ligne

15 membres et 207 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
313 908
Messages
2 103 459
Membres
108 673
dernier inscrit
georsol