Comment annuler une macro dans une autre macro

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous , je suis nouveau et aussi en programmation je suis entrain de réaliser une macro dans le cadre d'un projet qui m'a été remis dans le cadre de mes études.
J'ai créer un formulaire dans lequel il n'y a que deux boutons "annuler" et "ok" toutefois quand je clique sur "annuler" le formulaire se ferme mais la macro au niveau du module continue de ce lancer. voici ci-dessous le code de mon bouton "annuler":
Lorsque je lance la macro on me renvoie dans mon code au niveau de "Page_de_Garde.show" lorsque je clic sur debogage

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Sub ajoutConsultant()
'Initialise les valeurs de la boîte de dialogue
Page_de_Garde.Text_Adresse = ""
Page_de_Garde.Text_BE = ""
Page_de_Garde.Text_Beneficiaire = ""
Page_de_Garde.Text_BP = ""
Page_de_Garde.Text_consultant = ""
Page_de_Garde.Text_debut = ""
'Page_de_Garde.Text_Fin = ""
Page_de_Garde.Text_lieu = ""
Page_de_Garde.Text_Tel = ""
'ouverture de la boite de dialogue page de garde
Page_de_Garde.Show
'selection de la Feuille consultant ou base de donnée
Sheets("Base de donnée").Select
'sélection de la ligne 2
Rows("2:2").Select
'insertion d'une ligne vide
Selection.Insert shift:=xlDown
'venir sur la cellule A2
Range("a2").Select
ActiveCell.Formula = Page_de_Garde.Text_BE
'venir sur la cellule B2
Range("b2").Select
ActiveCell.Formula = Page_de_Garde.Text_consultant
'venir sur la cellule C2
Range("c2").Select
ActiveCell.Formula = Page_de_Garde.Text_Tel
'venir sur la cellule D2
Range("d2").Select
ActiveCell.Formula = Page_de_Garde.Text_Adresse
'venir sur la cellule E2
Range("e2").Select
ActiveCell.Formula = Page_de_Garde.Text_BP
'venir sur la cellule F2
Range("f2").Select
ActiveCell.Formula = Page_de_Garde.Text_Beneficiaire
'venir sur la cellule G2
Range("g2").Select
ActiveCell.Formula = Page_de_Garde.Text_lieu
'venir sur la cellule H2
Range("h2").Select
ActiveCell.Formula = Page_de_Garde.Text_debut
'venir sur la cellule I2
Range("i2").Select
ActiveCell.Formula = Page_de_Garde.Text_Fin
'venir sur la cellule J2
Range("j2").Select
If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO14001.Value = False) And (Page_de_Garde.Check_ISO22000.Value = False) And (Page_de_Garde.Check_OHSAS18001.Value = False)) Then
    'ActiveCell.Formula = "ISO 9001:2015"
    'Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-2015 (avec méthode conçue).xlsm")
Else
    If ((Page_de_Garde.Check_ISO14001.Value = True) And (Page_de_Garde.Check_ISO9001.Value = False) And (Page_de_Garde.Check_ISO22000.Value = False) And (Page_de_Garde.Check_OHSAS18001.Value = False)) Then
        ActiveCell.Formula = "ISO 14001:2015"
        Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 14001-2015.xlsm")
    Else
        If ((Page_de_Garde.Check_ISO22000.Value = True) And (Page_de_Garde.Check_ISO14001.Value = False) And (Page_de_Garde.Check_ISO9001.Value = False) And (Page_de_Garde.Check_OHSAS18001.Value = False)) Then
              ActiveCell.Formula = "ISO 22000:2005"
              Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 22000-2005.xlsm")
        Else
            If ((Page_de_Garde.Check_OHSAS18001.Value = True) And (Page_de_Garde.Check_ISO9001.Value = False) And (Page_de_Garde.Check_ISO14001.Value = False) And (Page_de_Garde.Check_ISO22000.Value = False)) Then
                 ActiveCell.Formula = "OHSAS:2007"
                 Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\OHSAS 18001-2007.xlsm")
            Else
                If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO14001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = False) And (Page_de_Garde.Check_OHSAS18001.Value = False)) Then
                     ActiveCell.Formula = "ISO 9001/ISO 14001"
                     Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 14001.xlsm")
                Else
                    If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = True) And (Page_de_Garde.Check_ISO14001.Value = False) And (Page_de_Garde.Check_OHSAS18001.Value = False)) Then
                         ActiveCell.Formula = "ISO 9001/ISO 22000"
                         Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 22000.xlsm")
                    Else
                        If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_OHSAS18001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = False) And (Page_de_Garde.Check_ISO14001.Value = False)) Then
                             ActiveCell.Formula = "ISO 9001/OHSAS 18001"
                             Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-OHSAS 18001.xlsm")
                       Else
                            If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO14001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = True) And (Page_de_Garde.Check_OHSAS18001.Value = False)) Then
                                 ActiveCell.Formula = "ISO 9001/ISO 14001/ISO 22000"
                                 Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 14001-ISO 22000.xlsm")
                            Else
                                If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO14001.Value = True) And (Page_de_Garde.Check_OHSAS18001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = False)) Then
                                     ActiveCell.Formula = "ISO 9001/ISO 14001/ISO 22000"
                                     Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 14001-ISO 22000.xlsm")
                                Else
                                    If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = True) And (Page_de_Garde.Check_OHSAS18001.Value = True) And (Page_de_Garde.Check_ISO14001.Value = False)) Then
                                        ActiveCell.Formula = "ISO 9001/ISO 22000/OHSAS 18001"
                                        Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 22000 -OHSAS 18001.xlsm")
                                    Else
                                        If ((Page_de_Garde.Check_ISO9001.Value = True) And (Page_de_Garde.Check_ISO14001.Value = True) And (Page_de_Garde.Check_ISO22000.Value = True) And (Page_de_Garde.Check_OHSAS18001.Value = True)) Then
                                           ActiveCell.Formula = "Tous les Quatre(04)référentiels"
                                           Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 14001-ISO 22000-OHSAS 18001.xlsm")
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End If
End Sub

Merci encore pour votre aide

03/11/2016, 10h53
Menhir

Pourquoi avoir mis ton second code sous forme d'image ? Ca n'est vraiment pas pratique pour le reprendre.

A mon avis, il y a au moins deux problème dans ce code.

D'abord, tu mets une instruction (Unload Me) après un Exit Sub ce qui ne sert à rien.
Le Exit Sub demande à l'exécution de quitter le Sub. Aucune chance donc que l'instruction suivante soit exécutée.

Je crois que tu as inversé les conditions à cause de la double négation : annuler une annulation équivaut à accepter.
Donc change vbNo en vbYes.

Quant à commenter ton premier code, je préfère m'abstenir, il y aurait trop à en dire.
Mais il contient beaucoup de choses inutiles dans sa première partie et "l'échelle" de If/Else de la seconde partie est loin d'être optimiser (à ta place, je créerai une variable String de 4 digits pour reprendre l'ensemble des ISO et je la testerais avec un Select Case, ce serait plus propre et plus lisible).

Merci Menhir, ces remarques m'aide j'ai modifier le vbno et aussi le unload me et ça annule bien mais la macro "ajoutconsultant" se déclenche toujours.
Quand tu me demandes de créer les variables en 4 digits au niveau des else/if pour être honnête je ne connais pas comment m'y prendre; comme je l'ai précisé au début je suis vraiment nouveau dans la programmation en général ça fait à peine 1 mois que je désire faire de la programmation.
Comment pourrais-je faire arrêter cette macro?
Voici joint le code du bouton "annuler":
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub ANNULER_Click() 'Déclaration de la variable Confirm Dim confirm As Single 'Permet de sortir un message d'avertissement confirm = MsgBox("Si vous annulez la procédure, vous perdrez toutes les données entrées." & "voulez vous rester ?", vbYesNo + vbCritical, "Abandon de la procédure") If confirm = vbYes Then Exit Sub End If Unload Me End Sub
merci encore pour tes remarques et ton aide

Citation:

Envoyé par pemeco

Merci Menhir, ces remarques m'aide j'ai modifier le vbno et aussi le unload me et ça annule bien mais la macro "ajoutconsultant" se déclenche toujours.

Je ne comprends pas comment elle pourrait se lancer alors qu'elle n'est même plus inscrite dans ta macro ANNULER_Click().
Il y a des informations que tu ne donnes pas.

Citation:

Quand tu me demandes de créer les variables en 4 digits au niveau des else/if pour être honnête je ne connais pas comment m'y prendre;

Tu fais un truc qui ressemble à ça.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Dim MonISO As String MonISO = IIf(Page_de_Garde.Check_ISO9001.Value,"1","0") & IIf(Page_de_Garde.Check_ISO14001.Value,"1","0") & IIf(Page_de_Garde.Check_ISO22000.Value,"1","0") & IIf(Page_de_Garde.Check_OHSAS18001.Value,"1","0") Select Case MonISO Case "1000" 'ActiveCell.Formula = "ISO 9001:2015" 'Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-2015 (avec méthode conçue).xlsm") Case "0100" ActiveCell.Formula = "ISO 14001:2015" Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 14001-2015.xlsm") Case "0010" ActiveCell.Formula = "ISO 22000:2005" Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 22000-2005.xlsm") ... etc ...
Voir https://msdn.microsoft.com/fr-fr/lib.../gg278665.aspx

03/11/2016, 12h26
unparia

Bonjour
Hormis (hé oui ...) le fait que nous ne sommes pas là dans du Excel (la section de ce forum), mais en plein VBA (autre section) ... ===>>
-1) je ne vois aucune boucle, dans le code montré.
Et dans ce cas : arrêter quoi, exactement ?
Il faudrait mettre à chaque ligne de code une expression conditionnelle d'arrêt ??????
- 2) encore un "mécanisme" à coups de Select, Activecell, etc ... !
- 3) une utilisation abusive de la propriété Formula
Etc ...
On continue ici ou on va dans la section adéquate de ce forum ?
03/11/2016, 13h13
pemeco

Merci :D Menhir J'ai testé avec le "select case" et ça fonctionne bien.
unparia tu as raison j'en ai abusé parce que je ne connaissais pas autre chose comme ce que Menhir vient de me montrer mais j'apprends encore...

Citation:

Je ne comprends pas comment elle pourrait se lancer alors qu'elle n'est même plus inscrite dans ta macro ANNULER_Click().
Il y a des informations que tu ne donnes pas.

je vais essayer d'être plus explicite.
j'ai créer un formulaire celui joint en dessous, dans ce formulaire l'utilisation devra y inscrire ces paramètres.
Si quelque chose est inscrit dans ce dernier l'information s'enregistre néanmoins dans la feuille que j'ai disposé à cet effet.
Et je souhaiterais que lorsque que l'on clique sur "Annuler" qu'il n y ai pas d'enregistrement.
J'espère avoir donné plus d'information
03/11/2016, 13h24
Menhir

Je n'avais pas vu que c'est ta macro qui lançait ton formulaire.
Je ne m'y attendait pas parce qu'il est illogique de procéder ainsi.

En fait, il faudrait que tu fasses le contraire : que ce soit ton bouton Ok qui lance la macro (du moins la seconde partie).
La première partie serait à mettre dans l'initialisation du UserForm.

Dans ton bouton Annulé, tu n'aurais alors (après le MsgBox) que :

Code:

If confirm = vbNo Then Unload Me

Bref, il faut que tu repenses la structure générale de l'application.
03/11/2016, 14h22
pemeco

Merci beaucoup ça fonctionne sans encombre :D:D:D:D:D:D:D...
Sans vouloir t'embêter est-il possible d'ouvrir les fichiers excel sans passer par la racine habituelle.
Je m'explique comme puisque tous les fichiers que j'appelais de cette façon

Code:

Workbooks.Open ("C:\Users\Pemeco\Desktop\Fichier Diagnostic\ISO 9001-ISO 22000 -OHSAS 18001.xlsm")

existe t-il un code permettant d'appeler ça de façon indépendante pour que même si je déplace le dossier dans une clé USB ça puisse toujours appeler lesdits fichiers.
Merci encore le problème là a été résolu plus que je ne l'imaginais
03/11/2016, 14h46
halaster08

Bonjour,

Si le classeur que tu souhaite ouvrir se trouve dans le même répertoire que celui qui execute la macro tu peux utiliser

Code:

Workbooks.Open (thisworkbook.path & "\ISO 9001-ISO 22000 -OHSAS 18001.xlsm")
04/11/2016, 12h59
pemeco

Merci halaster08 le code fonctionne très bien quand tous les dossiers reste dans mon pc mais dès que je change de support il affiche une erreur. Et on dit que le fichier a été déplacé, renommé ou supprimé..
04/11/2016, 13h07
halaster08

Après déplacement les deux fichiers sont bien dans le même répertoire? "ISO 9001-ISO 22000 -OHSAS 18001.xlsm" n'a pas changé de nom?
Si tu lui demande d'afficher le chemin, tu obtiens bien le nouveau?

Code:

msgbox thisworkbook.path & "\ISO 9001-ISO 22000 -OHSAS 18001.xlsm"

Comment lance tu la macro? via un bouton ou via l'interface vba?
05/11/2016, 08h11
pemeco

Bonjour à tous,
halaster08 Je lance ma macro via un bouton présent sur mon interface
07/11/2016, 12h48
halaster08

Et si tu le lance depuis vba, ça bug aussi? si non le problème vient du bouton.

Tu n'as pas répondu a mon autre question si tu lui demande d'afficher le chemin que vois tu? le c:/ ... du fichier initial ou la nouvelle adresse (clé USB, autre machine)
11/11/2016, 09h22
pemeco

Bonjour halaster08 je vois le chemin de la nouvelle adresse, et ça fonctionne avec le bout de code :

Code:

Workbooks.Open (ThisWorkbook.Path & "\ISO 14001-2015.xlsm")

Le fichier s'ouvre peu importe qu'il soit dans une clé USB ou autre.
Merci beaucoup :) :) :)
11/11/2016, 09h29
pemeco

Rebonjour, j'aimerais que les fichiers que je souhaite ouvrir via cet interface soient protéger en partie donc que juste certaines cellules soit modifiable et ces classeurs comportent plusieurs je voudrais certaines feuilles soient protégées et d'autre non. Est-ce possible? Si oui comment pourrais je faire ça ?
Merci pour votre aide.