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: 17
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é
Bonjour à toutes et à tous,
Eh bien me revoilà. J'ai mis en place le code pour l'initialize du formulaire UfGestTemps, ça fonctionne à-peu-près bien car je rencontre un petit soucis que je n'arrive pas à régler. Je souhaite que si la page (0) est active alors la TextBox1 a le focus sinon c'est le Cbx_Salarié qui a le focus. J'ai mis quelque chose dans le code qui devrait faire cela, mais ça ne fonctionne pas.
De plus, le donneur d'ordre souhaite changer la combo de la feuille "Saisie" par un formulaire de choix et ça me barbe de tout refaire, mais bon ça c'est mon affaire.
Pouvez-vous m'aider s'il vous plaît ?
Je vous en remercie par avance.
VB:
Private Sub UserForm_Initialize()
Dim Ltbx As Byte
   
    cl.initiate Me 'instanciation des textbox taggés "Heure"
    EnableEvents = True
   
            For Ltbx = 0 To 3
                Me.MultiPage1.Pages(Ltbx).Enabled = IIf(Me.MultiPage1.Value = Ltbx, True, False)

        Select Case Sheets("Saisie").ComboMenus

            Case "Enregistrer un(e) employé(e)"
                Me.MultiPage1.Value = 0
                Me.TextBox1.SetFocus
                Me.Label1.Visible = False
                Me.Cbx_Salarié.Visible = False
           
            Case "Enregistrer le planning horaires"
                Me.MultiPage1.Value = 1
                Me.Cbx_Salarié.SetFocus
                Me.MultiPage1.Pages(0).Enabled = True
           
            Case "Editer les plannings"
                Me.MultiPage1.Value = 2
                Me.Cbx_Salarié.SetFocus
                Me.MultiPage1.Pages(0).Enabled = True
               
            Case "Enregistrer un contrat horaires"
                Me.MultiPage1.Value = 3
                Me.Cbx_Salarié.SetFocus
                Me.MultiPage1.Pages(0).Enabled = True
               
        End Select
               Next Ltbx

    Me.Cbx_Salarié.Clear 'Chargement Combo "Salariés"
   
    With Sheets("Liste agents").ListObjects("t_Noms")
        For I = 1 To .ListRows.Count
            Me.Cbx_Salarié.AddItem .DataBodyRange(I, 2)
        Next I
    End With
    LoadLBx Me.Controls("Lbx_Employés"), Sheets("Liste agents").ListObjects("t_Noms")
   
    If Weekday(Now, 2) <> 1 Then 'initialisation de la date du début au lundi de la semaine en cours
        Me.Tbx_DebSem = Format(Now - Weekday(Now, 2) + 1, "dd/mm/yyyy")
    Else
        Me.Tbx_DebSem = Format(Now, "dd/mm/yyyy")
    End If
   
    For I = 1 To 7 'initialisation des checkbox à true
        Me.Controls("ChBx_" & I).Value = True
    Next I
       
    Me.Cbx_Mois.Clear
    For I = 1 To 12
        Me.Cbx_Mois.AddItem Format(DateSerial(Year(Now), I, 1), "mmmm")
    Next I
    Me.Tbx_Année = Year(Now)
   
For Each pag In MultiPage1.Pages: lC = lC & CStr(pag.Caption): Next: minlarge = Len(lC) * 7 '!!!!!!!!!!!!!!!!!!!!!
   
    For Each pag In MultiPage1.Pages
        ReDim Preserve Mpage(0 To pag.Index)
        WW = 0: HH = 0
        For Each Ctrl In pag.Controls
            If Ctrl.Left + Ctrl.Width + 20 > WW Then WW = Ctrl.Left + Ctrl.Width + 20: If WW < minlarge Then WW = minlarge
            If Ctrl.top + Ctrl.Height + 50 > HH Then HH = Ctrl.top + Ctrl.Height + 50
        Next Ctrl
        Mpage(pag.Index).Width = WW: Mpage(pag.Index).Height = HH
        Mpage(pag.Index).hCaption = Me.Height - Me.InsideHeight
        Mpage(pag.Index).Weight_Cadre = Me.Width - Me.InsideWidth
    Next pag
         
    resizeMulti
    End Sub
 

NONO14

XLDnaute Impliqué
Hello

Est ce que tu peux reposter ton dernier fichier, pour être sur de travailler sur le bon
et ainsi pouvoir tester

formulaire de choix?? ce serait quoi?
Voici le fichier.
Pour le formulaire, je ne sais pas encore ce qu'il veut vraiment, quelque chose de simple et de pratique à gérer. La Combo me paraît être une bonne solution, mais...
 

Pièces jointes

  • PointHeure10.xlsm
    709.8 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
bon..
quelques éléments

1) j'ai supprimé un de deux formulaires de mot de passe
2) dans la feuille calcul, table des actions j'ai ajouté une colonne "Autorisation" pour indiquer un niveau d'accès: Admin ou Employé
3) le choix d'une action dans le combomenu lance le formulaire de saisie de mot de passe
==> celui ci cherche lequel il faut saisir en fonction du niveau d'accès
les deux mots de passe "falaise" et "admin01" sont définis une SEULE fois dans le module mDéclarations: plus facile pour la maintenance

4) une fois le mot de passe validé, le formulaire USFGestTemps est lancé
le code associé fait ceci
a: cache les 4 pages du multipage
b: ré-affiche la ou les pages en fonction de l'action
c: il manque des cases à traiter
 

Pièces jointes

  • PointHeure11.xlsm
    676.4 KB · Affichages: 3

NONO14

XLDnaute Impliqué
bon..
quelques éléments

1) j'ai supprimé un de deux formulaires de mot de passe
2) dans la feuille calcul, table des actions j'ai ajouté une colonne "Autorisation" pour indiquer un niveau d'accès: Admin ou Employé
3) le choix d'une action dans le combomenu lance le formulaire de saisie de mot de passe
==> celui ci cherche lequel il faut saisir en fonction du niveau d'accès
les deux mots de passe "falaise" et "admin01" sont définis une SEULE fois dans le module mDéclarations: plus facile pour la maintenance

4) une fois le mot de passe validé, le formulaire USFGestTemps est lancé
le code associé fait ceci
a: cache les 4 pages du multipage
b: ré-affiche la ou les pages en fonction de l'action
c: il manque des cases à traiter
Merci beaucoup, je regarde ton travail et je te redis.
 

NONO14

XLDnaute Impliqué
Bonjour à toutes et à tous,
vgendron, merci pour le fichier que j'ai testé. Le système pour les mots de passe est très intéressant.
Per contre, je rencontre un petit soucis au chargement du formulaire GestTemps, la page plannings ne se remplie pas correctement à l'initialize, il manque le n° de semaine et une date. Je dois pouvoir me débrouiller.
Est-ce que dans le tableau des droits d'accès dans la feuille Calcul je peux ajouter le nom des feuilles du classeur pour en gérer également les accès ?
Je dois m'absenter quelques heures, je reviens vers vous dès que possible.
 
Dernière édition:

vgendron

XLDnaute Barbatruc
Je sais pas trop ce que tu as fait.. mais il y a plein de bout de codes qui ne fonctionnent plus
tu as supprimé des with...
j'ai remis les deux fonctions "proteger" et "reproteger" pour ta gestion de la protection des feuilles

dans le combo, tu as 7 actions différentes, mais seulement 4 pages sur le multi==> plusieurs actions sont gérées par la meme page
il faut donc tratier tous les cas pour activer la page adéquate

il va sans doute falloir revoir la gestion des mots de passe
à priori l'admin a droit de tout faire.. et de passer d'une page à l'autre sans avoir à repasser par le combo

quand tu selectionnes une action limitée à un employé: le mot de passe à mettre est falaise.. et pas le mot de passe de l'employé
==> l'employé saisi "falaise"
puis le page associée à l'action apparait, MAIS l'employé peut selectionner n'importe qui.. il n'est pas identifié..
 

Pièces jointes

  • PointHeure12.xlsm
    679.7 KB · Affichages: 1

vgendron

XLDnaute Barbatruc
Regarde la PJ
j'ai ajouté une gestion de l'utilisateur pour démarrer
1) selectionnes une action pour un employé
2) le usf mot de passe est affiché avec la liste des employés
3) selectionner un employé
4) saisir SON mot de passe
5) le USFGestTemps est lancé avec l'employé selectionné.. et impossible d'en changer
 

Pièces jointes

  • PointHeure13.xlsm
    695.4 KB · Affichages: 5

NONO14

XLDnaute Impliqué
vgendron,
J'ai regardé le fichier qui a quelque peu changé de physionomie mais reste dans l'esprit de ce qui m'est demandé. J'aurais des petites modifications à apporter concernant les autorisations mais dans l'ensemble ça me plaît pas mal. Je te remercie chaleureusement pour ce travail. Il me reste encore un peu de boulot avant d'en terminer.
J'ai remarqué que lorsque l'on clique sur "Enregistrer le planning horaires" dans la Combo de la feuille "Saisie" et que le formulaire UfGestTemps s'affiche sur la page "Saisie", il manque le n° de la semaine en cours ainsi que la date de fin de la semaine. Je vais regarder si je peux trouver la solution pour remédier à ce petit soucis.
Je te réitère mes chaleureux remerciements
 

vgendron

XLDnaute Barbatruc
c'est dans l'initialize qu'il manque ceci

VB:
If Weekday(Now, 2) <> 1 Then 'initialisation de la date du début au lundi de la semaine en cours
        Me.Tbx_DebSem = Format(Now - Weekday(Now, 2) + 1, "dd/mm/yyyy")
    Else
        Me.Tbx_DebSem = Format(Now, "dd/mm/yyyy")
    End If
    
    'les deux lignes manquantes:
    Me.Tbx_NumSem = WorksheetFunction.IsoWeekNum(Now)
    Me.Tbx_FinSem = CDate(Me.Tbx_DebSem) + 6
 

NONO14

XLDnaute Impliqué
Pour la suite je dois mettre en place les codes pour les actions suivantes et qui n'ont aucun rapport avec le formulaire UfGestTemps.

- Modifier un(e) employé(e) - Feuille "Liste agents" accès à la colonne C uniquement.

- Modifier un pointage - Feuille "Saisie" accès aux colonnes E à L uniquement et idéalement seulement pour l'agent concerné (avec un choix de Nom dans une Combo, je réfléchi à ça).

- Modifier le planning - Feuille "Planning" accès aux colonnes E à J uniquement et idéalement seulement pour l'agent concerné (avec un choix de Nom dans une Combo, je réfléchi à ça également).

- Sauvegarder les pointages - Feuille "Saisie" et "Recap" - Déverrouiller les feuilles le temps du transfert puis verrouillage.

- Editer le tableau des pointages - Feuille "Recap" - Créer un tableau avec le code de l'agent, Nom et Prénom, date, puis les colonnes J à N. Faire un tri sur le code de l'agent et sur les dates. Ensuite imprimer le tableau.

Comme tu peux le constater, je ne suis pas encore au bout de ma peine. Mais bon je ne suis pas tenu par un délai trop court.

Merci encore pour le dernier fichier, tu m'as enlevé une grosse épine du pied. 👍👍
 

NONO14

XLDnaute Impliqué
c'est dans l'initialize qu'il manque ceci

VB:
If Weekday(Now, 2) <> 1 Then 'initialisation de la date du début au lundi de la semaine en cours
        Me.Tbx_DebSem = Format(Now - Weekday(Now, 2) + 1, "dd/mm/yyyy")
    Else
        Me.Tbx_DebSem = Format(Now, "dd/mm/yyyy")
    End If
   
    'les deux lignes manquantes:
    Me.Tbx_NumSem = WorksheetFunction.IsoWeekNum(Now)
    Me.Tbx_FinSem = CDate(Me.Tbx_DebSem) + 6
Merci pour ta réponse, j'avais réussi à trouver ce qui manquait sauf que j'avais mis +7 au lieu de +6.
 

NONO14

XLDnaute Impliqué
Bonjour à toutes et à tous,
Après une nuit de repos je me remets à mon ouvrage. Mais ce matin rien ne va comme je le souhaite.
Je viens de m'apercevoir que dans l'UfGestTemps, la page "Saisie", j'avais complètement oublié d'ajouter des TextBox pour la saisie des heures du soir. Bon ce n'est pas trop grave.
Par contre, j'ai plein de bug à tous les niveaux, des calculs qui ne se font pas, des transferts de données qui ne vont pas aux bons endroits dans les tableaux, etc...
Depuis hier, je n'ai touché à rien du travail fait par vgendron et je ne comprends pas ce qui se passe.
Je vais reprendre mon application code par code et essayer de règler tout ça.
Je reviendrai vous voir ensuite...
Bonne journée à toutes et à tous
 

Discussions similaires

Réponses
9
Affichages
470
Réponses
5
Affichages
433
Réponses
3
Affichages
260

Statistiques des forums

Discussions
315 087
Messages
2 116 083
Membres
112 654
dernier inscrit
SADIKA