Macro imbriquée dans une autre

olivepao

XLDnaute Occasionnel
Bonjour à tous

J'ai créé deux macros. La première teste le remplissage des cellules, la seconde enregistre la feuille sous un nom et un répertoire défini par mes soins.

Les deux macros fonctionnent très bien lorsque je les teste individuellement.

Mon problème est que je désire activer ma macro d'enregistrement quand je sors du test de remplissage des cellules.

Je me casse la tête depuis une semaine sans trouver une solution.

Que dois-je modifier dans la macro ci-dessous pour que les deux macros fonctionnent correctement.


Code:
[COLOR="Blue"]Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'
' Macro exécutée à l'enregistrement du fichier qui teste le remplissage des cellules
'
Dim Remplace As Worksheet, TabloChamp As Variant, TabloMsg As Variant, i As Integer ' <-- Définition des variables

Set Remplace = Worksheets("Remplacement")
Champ = Array("B3", "B6", "B10", "B11", "B16", "B24", "B33", "G33") ' <-- Cellules a remplir obligatoirement
    TabloMsg = Array("Service                                           ", _
                                 "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(Champ) ' <-- Teste les 8 éléments du classeur, remplis ou pas remplis (boucle)
        
          If Remplace.Range(Champ(i)) = "" Then  ' <-- Teste si les cellules à remplir obligatoirement, le sont !
         
                 ' <-- FL1.Range(Champ(i)).Interior.ColorIndex = 5  ' <-- La cellule non remplie est colorisée en bleu / mais cela ne fonctionne pas !
                       
            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

            
            Cancel = True

    Exit For

        End If

    Next
    
End Sub[/COLOR]

J'ai bien pensé à une boucle du style Do Whlîle Loop mais j'obtiens le même résultat. Parfois le test s'effectue sur 1 ou deux cellules et effectue la macro d'enregistrement qui se nomme Sauve() et qui est dans ThisWorkBook. Parfois le test boucle de façon continue (avec Do While Loop).

Quand je clic sur l'cône d'enregistrement le macro teste si toutes les cellules sont remplies. Si elles sont toutes remplies l'enregistrement s'effectue.

Par contre tant que toutes les cellules ne sont pas remplies le teste doit de remplissage doit s'effectuer sans que l'enregistrement soit effectué.


:) Merci de votre précieuse aide
 
Dernière édition:
C

Compte Supprimé 979

Guest
Re : Macro imbriquée dans une autre

Bonjour Olivepao,

Pourrais-tu éditer ton premier post et enlever le GRAS, c'est pénible à lire :eek:

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Cancel = Not VerifOK
  ' Mettre ici le code pour enregistrer sous
End Sub
Function VerifOK()
' Macro exécutée à l'enregistrement du fichier qui teste le remplissage des cellules
'
Dim Remplace As Worksheet, TabloChamp As Variant, TabloMsg As Variant, i As Integer ' <-- Définition des variables
' Met à vrai le retour de la fonction
VerifOK = True
' Vérifie si tout es tremplie
Set Remplace = Worksheets("Remplacement")
Champ = Array("B3", "B6", "B10", "B11", "B16", "B24", "B33", "G33") ' <-- Cellules a remplir obligatoirement
TabloMsg = Array("Service", _
  "Nom et prénom de la personne à remplacer  ", _
  "Taux actuel" & vbCrLf, _
  "Taux demandé" & vbCrLf, _
  "Justification de la demande" & vbCrLf, _
  "Remplacement pour le mois de" & vbCrLf, _
  "Votre nom et prénom" & vbCrLf, _
  "Date de la demande") ' <-- Texte du champ oublié
  For i = 0 To UBound(Champ) ' <-- Teste les 8 éléments du classeur, remplis ou pas remplis (boucle)
    If Remplace.Range(Champ(i)) = "" Then  ' <-- Teste si les cellules à remplir obligatoirement, le sont !
      ' <-- FL1.Range(Champ(i)).Interior.ColorIndex = 5  ' <-- La cellule non remplie est colorisée en bleu / mais cela ne fonctionne pas !
       MsgBox "Utilisateur " & Environ("username") & vbCrLf _
                           & "vous avez oublié de saisir le champ : " & vbCrLf _
                           & TabloMsg(i) & vbCrLf _
                           & "Veuillez le saisir svp ! !" & vbCrLf, _
                           vbOKOnly + vbExclamation, "-  ERREUR DE SAISIE  -"       ' <-- Mise en forme du message erreur
      VerifOK = False
      Exit For
    End If
  Next
End Function

A+
 
Dernière modification par un modérateur:
C

Compte Supprimé 979

Guest
Re : Macro imbriquée dans une autre

Re,

Juste un petit truc que veut dire vbCrLf à la fin de certaine ligne, je comprend pas
Oups, désolé

C'est un retour chariot à la ligne en VBA, plus tôt que de long espace et des CHR(13), mais c'est si j'avais bien compris ce que tu voulais faire !

Je me suis permis :D
 

olivepao

XLDnaute Occasionnel
Re : Macro imbriquée dans une autre

Bonjour Olivepao,

Pourrais-tu éditer ton premier post et enlever le GRAS, c'est pénible à lire :eek:

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Cancel = Not VerifOK
  ' Mettre ici le code pour enregistrer sous
End Sub
Function VerifOK()
' Macro exécutée à l'enregistrement du fichier qui teste le remplissage des cellules
'
Dim Remplace As Worksheet, Champ As Variant, TabloMsg As Variant, i As Integer ' <-- Définition des variables
' Met à vrai le retour de la fonction
VerifOK = True
' Vérifie si tout es tremplie
Set Remplace = Worksheets("Remplacement")
Champ = Array("B3", "B6", "B10", "B11", "B16", "B24", "B33", "G33") ' <-- Cellules a remplir obligatoirement
TabloMsg = Array("Service", _
  "Nom et prénom de la personne à remplacer  ", _
  "Taux actuel" & vbCrLf, _
  "Taux demandé" & vbCrLf, _
  "Justification de la demande" & vbCrLf, _
  "Remplacement pour le mois de" & vbCrLf, _
  "Votre nom et prénom" & vbCrLf, _
  "Date de la demande") ' <-- Texte du champ oublié
  For i = 0 To UBound(Champ) ' <-- Teste les 8 éléments du classeur, remplis ou pas remplis (boucle)
    If Remplace.Range(Champ(i)) = "" Then  ' <-- Teste si les cellules à remplir obligatoirement, le sont !
      ' <-- FL1.Range(Champ(i)).Interior.ColorIndex = 5  ' <-- La cellule non remplie est colorisée en bleu / mais cela ne fonctionne pas !
       MsgBox "Utilisateur " & Environ("username") & vbCrLf _
                           & "vous avez oublié de saisir le champ : " & vbCrLf _
                           & TabloMsg(i) & vbCrLf _
                           & "Veuillez le saisir svp ! !" & vbCrLf, _
                           vbOKOnly + vbExclamation, "-  ERREUR DE SAISIE  -"       ' <-- Mise en forme du message erreur
      VerifOK = False
      Exit For
    End If
  Next
End Function

A+

:(
Salut Bruno

J'ai tester ta proposition de code. Elle ne fonctionne pas tout à fait.

Si un champ ou des champs sont omis (même si tous les champs sont omis), la combobox indique qu'il manque le champ à remplir puis lorsque je clique sur OK, la combobox d'enregistrement s'affiche.

Il y a un problème à la sortie de la boucle. J'ai essayer quelques petites modifs mais sans succès. La macro aborte, tourne en rond de manière continuelle ou fait comme expliqué ci-dessus.

Merci de m'aider encore si tu peux. :)
 
Dernière édition:

olivepao

XLDnaute Occasionnel
Re : Macro imbriquée dans une autre

Re,

Sur le site : Cijoint.fr - Service gratuit de dépôt de fichiers
Tu peux aller jusqu'à 8 Mo

Sinon tu as : Free - Envoyez vos documents
En FTP tu vas jusqu'à 10 Go

Je pense quand même que ce n'est pas aussi gros, ou alors tu as un very, very gros soucy ;)

A+


Salut


Mon fichier se nomme FicheTEST Macro imbriquée.xls.

Le lien est Cijoint.fr - Service gratuit de dépôt de fichiers

Cijoint.fr - Service gratuit de dépôt de fichiers

Le fichier est gros mais pas de soucis, il y a quelques macros 2 USF et des couleurs pour fair joli !

PS il y a une protection sur la feuille mais le psw est vide. Il est là uniquement pour ne pas aller dans les cellules protégées quand je me déplace avec le curseur.

Bon week end et à bientôt
 
Dernière édition:

jeanpierre

Nous a quitté
Repose en paix
Re : Macro imbriquée dans une autre

Bonsoir olivepao, Bruno,

A part quelques gadgets (presque impréssionnants), il n'y a rien dans ton fichier.

Je n'ai pas envie de relire tout le fil pour comprendre ton souci.

Revois la chose un peu plus simplement. Merci.
 
C

Compte Supprimé 979

Guest
Re : Macro imbriquée dans une autre

Bonjour Jean-Pierre,

Olivepao,
comme quoi il faut mettre tout le code et non une bride sur le forum,
nous aurions compris tout de suite

Dans ton classeur tu mets
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Macro exécutée à l'enregistrement du fichier
' Macro crée par Olivier Paoliello le 7 juillet 2008
'
 Cancel = not VerifOK
 
 ' Mettre ici le code pour enregistrer sous
Sauve
 
End Sub
C'est effectivement le code que je t'avais donné,
sauf que toi tu rajoutes derrière l'appel à la procédure : Save
sans mettre de test

Donc la macro boucle forcément, pusique tu es dans BeforSave :confused:

Il faut faire comme ça
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'
' Macro exécutée à l'enregistrement du fichier
' Macro crée par Olivier Paoliello le 7 juillet 2008
'
Cancel = Not VerifOK
 
 ' Mettre ici le code pour enregistrer sous
If VerifOK = true Then
  Sauve
End if
 
End Sub

Il faut analyser ce qui se passe (mode déboggage)
 
Dernière modification par un modérateur:

olivepao

XLDnaute Occasionnel
Re : Macro imbriquée dans une autre

:) Boujour BrunoM45

Encore merci de t'être penché sur mon problème.

J'aurais dû penser à mettre un If mais quand on est trop pressé, on ne vois pas forcément ce qui est évident.


Par contre, il reste deux petits problèmes, j'essaye depuis ce matin de les résoudre.

J'ai bien essayé le débogueur mais je ne relève rien.

Le premier concerne la Fonction Function VerifOK. La comboboxx qui indique "Vous avez oublié de ..." doublonne après avoir exécuter mon instruction Range(TabloChamp(i)).Select ' <-- Position sur la première cellule non remplie.
J'ai essayer de mettre un -1 à For i = 0 To UBound(TabloChamp) mais sans succès


Le deuxième concerne l'enregistrement dans la procédure Sauve. La procédure fonctionne nickel, elle enregistre mon fichier dans le répertoire désiré et sous le nom désiré.Mais lorsque la procédure est terminée, J'ai une boîte de dialogue Enregister sous me demande sous quel nom je désire sauver mon fichier (Je ne comprend pas pourquoi excel considère le fichier comme non enregistré alors que le fichier est bien enregistré).

Il y a les pros et les autres, visiblement je fais partie des autres et encore !

Pour être clair et pour ceux qui prennent le train en marche voilà les procédures. Elles sont toutes dans ThisWorkBook.

Code:
[COLOR="Blue"]Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'
' Macro exécutée à l'enregistrement du fichier
'
 Cancel = Not VerifOK
  
  ' Mettre ici le code pour enregistrer sous
If VerifOK = True Then
  Sauve
End If
 
End Sub[/COLOR]


Code:
[COLOR="blue"]Function VerifOK()
' Macro exécutée à l'enregistrement du fichier qui teste le remplissage des cellules
'
Dim Remplace As Worksheet, TabloChamp As Variant, TabloMsg As Variant, i As Integer ' <-- Définition des variables

VerifOK = True  ' Met à vrai le retour de la fonction

Set Remplace = Worksheets("Remplacement")  ' Vérifie si tout es tremplie
    TabloChamp = Array("B3", "B6", "B10", "B11", "B16", "B24", "B33", "G33") ' <-- Cellules a remplir obligatoirement

TabloMsg = Array("CASS ou Unité", _
                            "Nom et prénom de la personne à remplacer  ", _
                            "Taux actuel" & vbCrLf, _
                            "Taux demandé" & vbCrLf, _
                            "Justification de la demande" & vbCrLf, _
                            "Remplacement pour le mois de" & vbCrLf, _
                            "Votre nom et prénom" & vbCrLf, _
                            "Date de la demande") ' <-- Texte du champ oublié
                            
For i = 0 To UBound(TabloChamp) - 1 ' <-- Teste les 8 éléments du classeur, remplis ou pas remplis (boucle)
        If Remplace.Range(TabloChamp(i)) = "" Then  ' <-- Teste si les cellules à remplir obligatoirement, le sont !
    
                         MsgBox "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
                         
                         Range(TabloChamp(i)).Select ' <-- Position sur la première cellule non remplie
                         
                         'Range(TabloChamp(i)).Interior.ColorIndex = 5  ' <-- La cellule non remplie est colorisée en bleu / mais cela ne fonctionne pas !

VerifOK = False

      
Exit For

        End If
        
  Next
  
End Function[/COLOR]


Code:
[COLOR="Blue"]Sub Sauve()
'
' Sauvegarde d'un classeur avec les valeurs récupérées dans des cellules.
' Le mois, suivant, le mois courant ainsi que l'année sont ajouté au nom de la sauvegarde.
' Il est tenu compte du passage à l'année suivante si la sauvegarde est effectuée en décembre.
'

MsgBox "Nous sommes le " & Date & " il est  " & Time & " " + 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


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("B6") ' <-- Récupère la cellule B6 (personne absente) de la feuille "Remplacement"
m = Month(Date)

CreationRepertoire Chemin ' <-- Appel de la macro qui va vérifier et créer le répertoire.

Application.EnableEvents = False
On Error Resume Next
Cancel = True

If m = 12 Then
ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) + 1 & "-" & Month(Now) - 11 & ".xls", _
                           FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                           
' <-- Si l'on est au mois de décembre, l'année sera incrémentée de 1 et le mois sera 01 (janvier).

Else

ActiveWorkbook.SaveAs Chemin & "\" & Lieu & "-" & NomAbs & "-" & Year(Now) & "-" & Month(Now) + 1 & ".xls", _
                            FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                            
' <-- du mois de janvier au mois de novembre, le mois sera incrémenté de 1.
                           
End If

On Error GoTo 0
Application.EnableEvents = True

End Sub[/COLOR]


Code:
[COLOR="blue"]Sub CreationRepertoire(Chemin As String)                        ' <-- Macro liée à Sauve
'
' 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[/COLOR]
 
C

Compte Supprimé 979

Guest
Re : Macro imbriquée dans une autre

Salut OlivePao,

Le premier concerne la Fonction Function VerifOK. La comboboxx qui indique "Vous avez oublié de ..." doublonne
Autant pour moi, je t'ai induit en erreur la dernière fois avec mon code.

Je pense que tous tes soucis viennent de l'évènement BeforeSave

Essaye plutôt ce code :
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  '
  ' Macro exécutée à l'enregistrement du fichier
  ' Macro crée par Olivier Paoliello le 7 juillet 2008
  If VerifOK = False Then
    Cancel = True
    Exit Sub
  End If
  ' Mettre ici le code pour enregistrer sous
  Call Sauve
  SaveAsUI = False
  Cancel = True
End Sub

Tiens nous au courant ;)

A+
 

olivepao

XLDnaute Occasionnel
Re : Macro imbriquée dans une autre

Salut BrunoM45

Maintenant tout fonctionne comme je le désirais.

Un super grand merci pour ton aide. J'ai appris beaucoup avec toi

C'est en apprenant que l'on deviens forgeron.


Je dois encore faire une ou deux zone de saisie avec des "Puces" et des cases à cocher. Je vais faire mon possible pour réaliser cette procédure sans aide.
 

Discussions similaires

Réponses
2
Affichages
175
Réponses
26
Affichages
464

Statistiques des forums

Discussions
312 469
Messages
2 088 691
Membres
103 921
dernier inscrit
hhhh