Problèmes VBA - Activation des macros et Macros imbriquées

[olivepao]

😕 😕
Je vais essayer d'être clair afin que quelqu'un puisse m'aider à finaliser mon formulaire excel.

1. J'ai créé un formulaire exel au format modèle xlt. On ne peut enregistré le formulaire que si tous les champs ont été remplis. Une macro a été créée à cet effet et elle fonctionne correctement. Cette macro est du type "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)"

2. Le formulaire est enregistré sous la valeur de certaines cellules. La macro qui récupère la valeur des cellules et crée l'enregistrement du formulaire au format xls couplée à une autre macro qui elle teste la validité du répertoire d'enregistrement.

3. J'ai également inséré un macro qui est sensée faire fonctionner les macros uniquement si je suis entrain de créer mon formulaire xls (appel du fichier xlt) et ne pas fonctionner si je le reprend après enregistrement (appel du fichier xls). Cette macro est du type "Private Sub Workbook_Open()"

Après plusieurs jours d'essais, je rencontre les problèmes suivants :

Je ne sais pas où la macro expliquée au point 2 doit être placée afin qu'elle puisse fonctionner correctement tout en faisant que la macro expliquée au point 1 continue de fonctionner correctement.

La macro expliquée au point 3 ne fonctionne pas correctement car je pense que lorsque l'on utilise un modèle au format xlt, le formulaire (classeur) que l'on rempli n'est plus considérer comme xlt et je suppose que c'est la raison pour laquelle les macros en dehors de Private Sub Workbook_Open() ne fonctionnent pas.


Après ces longues explications, voici les macros en question elles sont dans "ThisWorkBook"

1 la macro eui teste la validité des champs

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim FL1 As Worksheet, TabloChamp As Variant, TabloMsg As Variant, i As Integer ' <-- Définition des variables

Set FL1 = Worksheets("Remplacement")
    TabloChamp = Array("B3", "C5", "C7", "C8", "B11", "B17", "B23", "G23") ' <-- Cellules a remplir
    TabloMsg = Array("CASS ou Unité                                            ", _
                                 "Nom et prénom de la personne à remplacer  ", _
                                 "Taux actuel                                                ", _
                                 "Taux demandé                                            ", _
                                 "Justification de la demande                        ", _
                                 "Remplacement pour le mois de                      ", _
                                 "Votre nom et prénom                                    ", _
                                 "Date de la demande                                     ") ' <-- Texte du champ oublié

    For i = 0 To UBound(TabloChamp) ' <-- Teste les 7 éléments du classeur, remplis ou pas remplis (boucle)
        
        If FL1.Range(TabloChamp(i)) = "" Then  ' <-- Teste si les cellules à remplir obligatoirement, le sont !
             
             ' <-- FL1.Range(TabloChamp(i)).Interior.ColorIndex = 5  ' <-- La cellule non remplie est colorisée en bleu / cela devrait fonctionner mais avec Excel 2000 ?
                       
            MsgBox "Utilisateur " & Environ("username") + Chr$(13) + Chr$(13) _
                         & "vous avez oublié de saisir le champ :     " + Chr$(13) + Chr$(13) _
                         & TabloMsg(i) + Chr$(13) + Chr$(13) _
                         & "Veuillez le saisir svp ! !" + Chr$(13) + Chr$(13), _
                         vbOKOnly + vbExclamation, "                      -  ERREUR DE SAISIE  -          "       ' <-- Mise en forme du message erreur

 ' <-- ici l'enregistrement ne fonctionne pas !
            
            Cancel = True
' <-- ici l'enregistrement ne fonctionne pas !
    Exit For
' <-- ici l'enregistrement ne fonctionne pas !
        End If
' <-- ici l'enregistrement ne fonctionne pas correctement (la combobox save est 7x et test sauté si pas tout rempli.
    Next
    
EnregistreClasseur ' <-- ici l'enregistrement ne fonctionne pas correctement - test sauté si pas tout rempli.

End Sub

2 Les macros d'enregistrement

Sub EnregistreClasseur()
'
' Macro pour l'enregistrement du classeur dans le répertoire défini et le nom prédéfini par les valeurs des cellules
'
' En supprimant la macro Private Sub Workbook_BeforeSave (pour tester l'enregistrement)
' cette procédure boucle 2 x sur elle même à l'enregistrement du classeur.

                   MsgBox "Utilisateur " & Environ("username") + Chr$(13) + Chr$(13) _
                         & "Nous sommes le " & Date & " il est  " & Time & " " + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "La demande de remplacement va être enregistrée sur votre disque personnel." + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "Le fichier est enregistré sur le disque I:\DemandeTournants    " + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "il se nomme CASS-Nom du Collaborateur-Date du remplacement     " + Chr$(13) + Chr$(13) + Chr$(13) + Chr$(13) _
                         & "Il ne vous reste plus qu'à lca faire parvenir par m@il au RU responsable du pool Tournants.        " + Chr$(13) + Chr$(13), _
                         vbOKOnly + vbExclamation, "                             -  LA DEMANDE EST REMPLIE CORRECTEMENT  -          "         ' <-- Mise en forme du message enregistrement
                  
Dim Chemin As String, Lieu As String, NomAbs As String, m

With Sheets("Remplacement")

Chemin = "I:\DemandeTournants"
Lieu = Sheets("Remplacement").Range("B3")       ' <-- Récupère la cellule B3 (Lieu de travail) de la feuille "Remplacement"
NomAbs = Sheets("Remplacement").Range("C5") ' <-- Récupère la cellule C5 (personne absente) de la feuille "Remplacement"
m = Month(Date)

CreationRepertoire Chemin

If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' <-- Décembre
Else
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False ' <-- Janvier à novembre
End If

End With

End Sub

Sub CreationRepertoire(Chemin As String)                        ' <-- Macro liée à EnregistreClasseur
'
' Macro création du répertoire si ce dernier n'existe pô !
'
    If Dir(Chemin, vbDirectory + vbHidden) = "" Then  ' <-- Vérifie si le répertoire existe. S'il n'existe pas, il est créé.
    MkDir Chemin
    End If
                
End Sub

3 La macro activant les macros en fonction de l'extention xlt ou xls

Private Sub Workbook_Open()
'
' Macro activée à l'ouverture du classeur
'
Application.EnableEvents = True ' <-- Si l'option est False les marcos ne seront pas exécutées à l'ouverture même si la sécurité est au minimum !

If ActiveWorkbook.Name Like "*" & ".xlt" Then
Application.EnableEvents = True
Else
Application.EnableEvents = False
End If

FORInfos.Show ' <-- Mode d'emploi à l'ouverture du classeur

End Sub

Je voulais joindre mon fichier excel zipé mais il fait 142 Ko alors que le maxi autorisé est de 48.8 Ko . . . dommage !

🙂 Je remerrcie par avance tous ceux et celles qui m'apporteront leur aide.