Microsoft 365 Ecrire une formule de calcul en Vba Excel

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
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

XLDnaute Impliqué
pour la page 1 de saisie.. tu as déjà le code associé au bouton "Vider grille"

sinon, pour faire plus "bourrin", un truc du genre
for each ctrl in me.multipage.activepage '??
if typeof ctrl =msform.textbox then ctrl=""
if typeof ctrl = msform.combobox then ctrl.listindex=-1

next ctrl
Ce que je souhaite, c'est lorsque je quitte une page, elle s'efface, de cette façon lors d'une prochaine saisie les objets sont vides. Mais bon ce n'est qu'un détail.
J'avais pensé à un truc de ce genre
VB:
Private Sub MultiPage1_Change()
    Dim i As Integer
    ' Effacer le contenu de la page précédente
    For i = 0 To MultiPage1.Pages.Count - 1
        If i <> MultiPage1.Value Then
            EffacerContenu MultiPage1.Pages(i)
        End If
    Next i
End Sub

Private Sub EffacerContenu(page As Object)
    Dim ctrl As Control
    For Each ctrl In page.Controls
        Select Case TypeName(ctrl)
            Case "TextBox", "ComboBox", "ListBox"
                ctrl.Value = ""
            Case "CheckBox", "OptionButton"
                ctrl.Value = False
            ' Ajoutez d'autres types de contrôles si nécessaire
        End Select
    Next ctrl
End Sub
 

vgendron

XLDnaute Barbatruc
plutot que boucler sur le nombre de pages tu peux faire
effacercontenu(me.multipage1.page(me.multipage1.value)) 'ca équivaut à un activepage..

ensuite.. j'ai aussi fait cette boucle pour effacer. l'ennui, c'est que ca efface tellement tout (notamment les dates de la semaine ) que quand tu cliques sur le spin bouton pour changer/reselectionner une semaine... et bien; ca plante..

tu peux peut etre garder ce besoin de customization pour plus tard... tu vas surement avoir d'autres sujets plus importants à régler avant..
 

NONO14

XLDnaute Impliqué
plutot que boucler sur le nombre de pages tu peux faire
effacercontenu(me.multipage1.page(me.multipage1.value)) 'ca équivaut à un activepage..

ensuite.. j'ai aussi fait cette boucle pour effacer. l'ennui, c'est que ca efface tellement tout (notamment les dates de la semaine ) que quand tu cliques sur le spin bouton pour changer/reselectionner une semaine... et bien; ca plante..

tu peux peut etre garder ce besoin de customization pour plus tard... tu vas surement avoir d'autres sujets plus importants à régler avant..
Oui je vais regarder pour régler ce petit soucis. Je te tiens au courant
 

NONO14

XLDnaute Impliqué
plutot que boucler sur le nombre de pages tu peux faire
effacercontenu(me.multipage1.page(me.multipage1.value)) 'ca équivaut à un activepage..

ensuite.. j'ai aussi fait cette boucle pour effacer. l'ennui, c'est que ca efface tellement tout (notamment les dates de la semaine ) que quand tu cliques sur le spin bouton pour changer/reselectionner une semaine... et bien; ca plante..

tu peux peut etre garder ce besoin de customization pour plus tard... tu vas surement avoir d'autres sujets plus importants à régler avant..
J'ai regardé dans mon formulaire et je n'ai pas ce soucis, ou alors on ne parle pas de la même chose.
C'est bien le bouton 'Vider la grille' de la page Saisie dont tu parles ?
 

NONO14

XLDnaute Impliqué
Bonjour à toutes et à tous,
J'ai codé l'effacement des objets du multipage comme suit, cependant je n'ai pas réussi à jouer sur les Tbx_DebSem et Tbx_FinSem, car lorsqu'elles sont vides, j'ai un message d'erreur "Incompatibilité de type".
Sinon, l'effacement se passe bien.

VB:
Private Sub MultiPage1_Change()
Dim Ob As Integer
Me.Cbx_Salarié.SetFocus
'On efface le contenu des pages précédentes
    For Ob = 0 To MultiPage1.Pages.Count = 1
    If Ob <> MultiPage1.Value Then
    EffacerContenu MultiPage1.Pages(Ob)
    End If
Next Ob
: resizeMulti
End Sub
Private Sub EffacerContenu(Page As Object)
Dim Ctrl As Control
    For Each Ctrl In Page.Controls
        Select Case TypeName(Ctrl)
    Case "ComboBox", "ListBox"
    Ctrl.Value = ""
    Case "CheckBox", "OptionButton"
    Ctrl.Value = False
        End Select
    Next Ctrl
    Me.Cbx_Salarié.Value = ""
    Me.Tbx_TotSem.Value = ""
    Me.Tbx_ContratHeures.Value = ""
    Me.Tbx_Hsup.Value = ""
    Me.Tbx_DebMois.Value = ""
    Me.Tbx_FinMois.Value = ""
    Me.Tbx_Employé.Value = ""
    Me.Tbx_CHeures.Value = ""
End Sub
 

Pièces jointes

  • PointHeure4.xlsm
    532.6 KB · Affichages: 3

vgendron

XLDnaute Barbatruc
Hello
c'est "normal".. c'est ce que je te disais, quand on vide ces deux textbox "DebSem" et "FinSem", ca déclenche les évènements des TextBox (Tbx_DebSem_Change), et c'est dedans que l'instruction "CDate(Me.Tbx_DebSem)" plante

au dela de ca, ces deux textbox sont liés au numéro de semaine (je viens de remarquer que tu avais remplacé le textbox par un combobox ?)
et donc, quand on va vouloir modifier le numéro de semaine, ca va à nouveau bugger...

plusieurs choses
1) veux tu vraiment un combobox pour le numéro de semaine? (dans ce cas, il faudrait remplir la liste, parce que pour l'instant, c'est vide
2) dans ta macro "EffacerContenu" tu vides bien les controls de la page en cours, MAIS tu vides aussi les Textbox des autres multipages.. ca sort un peu du cadre initial de la macro..

3) pour effacer un combobox, ou listbox..
plutot que mettre Combobox.value="", il vaut mieux deselectionner:
combobox.listindex=-1
ce qui a pour effet immédiat de déclencher l'évènement combobox_change qui vide la grille de saisie
et donc, le calcul des totaux se met à jour tout seul à 0==> plus besoin de vouloir les vider
 

NONO14

XLDnaute Impliqué
J'ai un petit soucis avec le Total heure semaine qui ne fait pas le total des minutes, de ce fait dans l'exemple ci-dessous j'ai 08:60 au lieu de 09:00.
1726128462361.png

Je pense que cela est dû au fait que les caractères sont au format Texte dans ces codes :
VB:
Public Function ConvertirHtoDec(HeureText As String) As Double
    h = CLng(Split(HeureText, ":")(0))
    mn = CLng(Split(HeureText, ":")(1))
    ConvertirHtoDec = h + mn / 100
End Function

Public Function ConvertirDecToH(HeureDec As Double) As String
    h = Int(HeureDec)
    mn = Round((HeureDec - h) * 100, 0)
    ConvertirDecToH = Format(h, "00") & ":" & Format(mn, "00")
End Function
 

NONO14

XLDnaute Impliqué
Hello
c'est "normal".. c'est ce que je te disais, quand on vide ces deux textbox "DebSem" et "FinSem", ca déclenche les évènements des TextBox (Tbx_DebSem_Change), et c'est dedans que l'instruction "CDate(Me.Tbx_DebSem)" plante

au dela de ca, ces deux textbox sont liés au numéro de semaine (je viens de remarquer que tu avais remplacé le textbox par un combobox ?)
et donc, quand on va vouloir modifier le numéro de semaine, ca va à nouveau bugger...

plusieurs choses
1) veux tu vraiment un combobox pour le numéro de semaine? (dans ce cas, il faudrait remplir la liste, parce que pour l'instant, c'est vide
2) dans ta macro "EffacerContenu" tu vides bien les controls de la page en cours, MAIS tu vides aussi les Textbox des autres multipages.. ca sort un peu du cadre initial de la macro..

3) pour effacer un combobox, ou listbox..
plutot que mettre Combobox.value="", il vaut mieux deselectionner:
combobox.listindex=-1
ce qui a pour effet immédiat de déclencher l'évènement combobox_change qui vide la grille de saisie
et donc, le calcul des totaux se met à jour tout seul à 0==> plus besoin de vouloir les vider
Ah d'accord, je regarde ça. J'ai remplacé la Combo par une TextBox comme à l'origine.
 
Dernière édition:

vgendron

XLDnaute Barbatruc
J'ai un petit soucis avec le Total heure semaine qui ne fait pas le total des minutes, de ce fait dans l'exemple ci-dessous j'ai 08:60 au lieu de 09:00.
Regarde la pièce jointe 1203353
Je pense que cela est dû au fait que les caractères sont au format Texte dans ces codes :
VB:
Public Function ConvertirHtoDec(HeureText As String) As Double
    h = CLng(Split(HeureText, ":")(0))
    mn = CLng(Split(HeureText, ":")(1))
    ConvertirHtoDec = h + mn / 100
End Function

Public Function ConvertirDecToH(HeureDec As Double) As String
    h = Int(HeureDec)
    mn = Round((HeureDec - h) * 100, 0)
    ConvertirDecToH = Format(h, "00") & ":" & Format(mn, "00")
End Function
Effectivement.. le calcul est bizarre...
je vérifie si c'était déjà comme ca dans l'autre appli
 

vgendron

XLDnaute Barbatruc
avec ces deux formules de conversion, ca me semble mieux..

VB:
Public Function ConvertirHtoDec(HeureText As String) As Double
    h = CLng(Split(HeureText, ":")(0))
    mn = CLng(Split(HeureText, ":")(1))
    ConvertirHtoDec = h + mn / 60
End Function

Public Function ConvertirDecToH(HeureDec As Double) As String
    
    'h = Int(HeureDec)
    'mn = Round((HeureDec - h) * 100, 0)
    ConvertirDecToH = Application.Text(HeureDec / 24, "[h]:mm") 'Format(h, "00") & ":" & Format(mn, "00")
End Function
 

NONO14

XLDnaute Impliqué
avec ces deux formules de conversion, ca me semble mieux..

VB:
Public Function ConvertirHtoDec(HeureText As String) As Double
    h = CLng(Split(HeureText, ":")(0))
    mn = CLng(Split(HeureText, ":")(1))
    ConvertirHtoDec = h + mn / 60
End Function

Public Function ConvertirDecToH(HeureDec As Double) As String
   
    'h = Int(HeureDec)
    'mn = Round((HeureDec - h) * 100, 0)
    ConvertirDecToH = Application.Text(HeureDec / 24, "[h]:mm") 'Format(h, "00") & ":" & Format(mn, "00")
End Function
Super ! C'est beaucoup mieux.
Je continue ma programmation et il y a encore du boulot.
Mille mercis pour ton aide
 

Discussions similaires

Réponses
9
Affichages
435
Réponses
5
Affichages
406
Réponses
3
Affichages
223

Statistiques des forums

Discussions
314 587
Messages
2 110 985
Membres
111 000
dernier inscrit
Mouhamedw