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

vgendron à dit:
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 · 11 Septembre 2024

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

vgendron à dit:
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 · 11 Septembre 2024

vgendron à dit:
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 ?

vgendron · 11 Septembre 2024

oui, c'est bien ce bouton, mais il ne vide QUE la grille.. les Tbx d'heure

NONO14 · 11 Septembre 2024

vgendron à dit:
oui, c'est bien ce bouton, mais il ne vide QUE la grille.. les Tbx d'heure

Oui c'est ça. Je n'ai pas de bug particulier, ou alors tu parles de l'ajout du code que tu as proposé pour effacer...

NONO14 · 12 Septembre 2024

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

vgendron · 12 Septembre 2024

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

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.

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

vgendron à dit:
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.

vgendron · 12 Septembre 2024

NONO14 à dit:
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

NONO14 · 12 Septembre 2024

vgendron à dit:
Effectivement.. le calcul est bizarre...
je vérifie si c'était déjà comme ca dans l'autre appli

J'ai vérifié et c'est déjà comme ça

vgendron · 12 Septembre 2024

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

vgendron à dit:

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

TooFatBoy · 12 Septembre 2024

Waouh ! C'est super beau !
On est loin du simple double-clic dans le tableau.

Microsoft 365 Ecrire une formule de calcul en Vba Excel

NONO14

XLDnaute Impliqué

Pièces jointes

ChTi160

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

Pièces jointes

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Discussions similaires