Discussion :

[olivepao]

Bonjour le forum

Dans mon classeur, j'ai une macro qui enregistre mon fichier sous un nom et une date récupérés dans les cellules.

Ma procédure de save fonctionne nickel mais je voudrais appeler une macro si mon fichier est déjé existant (c-a-d qu'il a déjà été enregistré une fois).

Dans ma macro Save1() qui est appelée la macro Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) j'ai ajouté un test qui me revoie sur ma macro Save2()

Ma macro Save2() est la suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Save2()
' Macro de sauvegarde après modification d'une demande déjà existante.
 
Dim OKModif As Integer
 
SaveAsUI = False ' <-- Empêche l'ouverture (inutile) de la boîte de dialogue "Enregistré sous . . ."
 
ActiveWorkbook.Save
 
OKModif = MsgBox("Nous sommes le " & Date & " il est  " & Time & " " + Chr$(13) + Chr$(13) + Chr$(13) _
                & "La demande a été modifiée correctement. " + Chr$(13) + Chr$(13) + Chr$(13), _
                vbOKOnly + vbExlamation + vbDefaultButton1, "                                        -  LA DEMANDE EST CORRIGÉE -          ")
                            ' <-- Mise en forme de la boîte de dialogue d'enregistrement.
 
If OKModif = vbOK Then
    Application.Quit                        ' <-- On quitte Excel
End If
 
End Sub

Mon problème est le suivant si mon if de Save1() me renvoie bien dans Save2(), après l'affichage de ma MsgBox : une ComboBox m'indique que le fichier Toto 2008-08 existe déjà voulez-vous le remplacer. Si je répond Non, je suis revoyé dans ma macro Save1().

Comment faire pour éviter ce retour et quitter Excel si je clic sur OK comme je l'indique dans ma macro Save2().

J'ai dû oublier quelque chose . . . mais quoi ?

Merci de votre précieuse aide.

[Invité]

Bonjour,

Comme vous ne donnez pas le code de la 1ère macro, je suppose que c'est quelque chose comme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If Okmodif = VbOk
.....le code
else
ThisWorkbook.Saved = True
Application.Quit

[ouskel'n'or]

Hello OlivePao,
Déjà, je simplifierais ton code :
Ton msgbox ne présente aucune option puisqu'il ne propose que le bouton VbOKOnly. Donc, ni ton OKModif ni ton if ne sont utiles, non plus que vbDefaultButton1 qui désigne le bouton actif par défaut (puisqu'il n'y en a qu'un)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Application.displayAlerts = false 'évite le message si fichier existant
'inutile ici puisque tu l'enregistres sous son propre nom. 
'Utile seulement si tu changes de nom de fichier et que tu l'enregistres avec SaveAs
 
MsgBox("Nous sommes le " & Date & " il est  " & Time & vbcrlf & vbcr & vbcr _
      & "La demande a été modifiée correctement. " & vbcr & vbcr & vbcr , _
      vbOKOnly + vbExlamation, "                                        -  LA DEMANDE EST CORRIGÉE -          ")
      ' <-- Mise en forme de la boîte de dialogue d'enregistrement.
ActiveWorkbook.Close True ' enregistre le fichier sous son propre nom et le ferme      
DoEvents 'donne le temps au système d'enregistrer le fichier et de le fermer
Application.Quit                        ' <-- On quitte Excel

Bon week-end

NB - VbCr = Chr(13) -> CR => Cariage Return => Retour Chariot sur les imprimantes à chariot (ou les machines à écrire d'antan)

[olivepao]

Boujour à tous,

je me rends compte que je n'ai pas été précis.

Le nom de mon fichier est constitué par la valeur de plusieurs cellules et de la date (+ 1 mois).

Création

1) le fichier est créé : l'enregistrement se déroule normalement.

Modification

2) les valeurs des cellules qui affectent le nom du fichier sont modifiées : un nouveau fichier est créé.

3) les valeurs des cellules qui n'affectent pas le nom du fichier le fichier existant est écrasé.


Lorsque j'enregistre mon fichier, les valeurs constituant le nom du fichier sont stokées dans des cellules inutiliées (invisibles pour l'utilisateur) afin que l'on puisse les comparer avec le précédent enregistrement.

Le points N° 1 fonctionne.

Le point N° 2 fonctionne. Seul petit bémol, comme on est en phase de modification, la saisie d'une nouvelle fiche ne devrait plas être possible.

Le point 3 : La macro Sauve2 (voir mon message précédent) est appellée, elle écrase le fichier existant.

Puis j'ai une combobox qui m'indique qu'un fichier existe et me demande si je veux l'écraser.

Et pour finir, je retourne dans Sauve1 et la procédure normale d'enregistrement (comme à la création) s'effectue (ce que je ne veux pas).

C'est pourquoi, je voulais passer par une deuxième macro d'enregistrement valable pour les points N° 2 et N° 3.

Je joints ma macro Sauve1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
Sub Sauve1()
' 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.
 
Dim Chemin As String, LieuTravail As String, LieuTravail2 As String, NomAbsent As String, NomAbsent2 As String, Fonction As String, Fonction2 As String, _
      Mois As String, Annee As String, FichierSauve As String, OuiNon As Integer, m
 
m = Month(Date)
 
If m = 12 Then
    Mois = (Month(Now) - 11)
    Annee = (Year(Now) + 1)                                ' <-- 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
    Mois = (Month(Now) + 1)
    Annee = (Year(Now))                                     ' <-- Du mois de janvier au mois de novembre, le mois sera incrémenté de 1.
 
End If
 
Mois = Format(Mois, "00")                                   ' <-- Formatage du mois afin que les mois de janvier à septembre aient la forme MM et non M.
 
Chemin = "I:\Repertoire" & "\" & Annee & "-" & Mois  ' <-- Définition du répertoire et du sous-répertoire
 
LieuTravail = Sheets("Mafeuille").Range("B3")              ' <-- Récupère la cellule B3 
NomAbsent = Sheets("Mafeuile").Range("B6")              ' <-- Récupère la cellule B6 
 
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 Sheets("Mafeuille").Range("B8") = 1 Then                  ' <-- Récupère la cellule B8 
    Fonction = "AS"
    Fonction2 = 1
 
        ElseIf Sheets("Mafeuille").Range("B8") = 2 Then
        Fonction = "ASA"
        Fonction2 = 2
 
        Else
        Fonction = "SR"
        Fonction2 = 3
 
End If
 
LieuTravail2 = Sheets("Mafeuille").Range("B3")
NomAbsent2 = Sheets("Mafeuille").Range("B6")
 
If Sheets("Mafeuille").Range("B3") = Sheets("Mafeuille").Range("G3") _
    And Sheets("Mafeuille").Range("B6") = Sheets("Mafeuille").Range("G6") _
    And Sheets("Mafeuille").Range("B8") = Sheets("Mafeuille").Range("D10") Then Call Sauve2
 
ThisWorkbook.Sheets("Mafeuille").Unprotect ""
ThisWorkbook.Sheets("Mafeuillet").Range("G3").Unprotect ""
ThisWorkbook.Sheets("Mafeuille").Range("G6").Unprotect ""
ThisWorkbook.Sheets("Mafeuille").Range("D10").Unprotect ""
 
ThisWorkbook.Sheets("Mafeuille").Range("G3") = LieuTravail2  ' <-- Code d'enregistrement lieu de travail
ThisWorkbook.Sheets("Mafeuille").Range("G6") = NomAbsent2  ' <-- Code d'enregistrement du nom
ThisWorkbook.Sheets("Mafeuille").Range("D10") = Fonction2     ' <-- Code d'enregistrement de fonction
 
ThisWorkbook.Sheets("Mafeuille").Range("G3").Protect ""
ThisWorkbook.Sheets("Mafeuille").Range("G6").Protect ""
ThisWorkbook.Sheets("Mafeuille").Range("D10").Protect ""
ThisWorkbook.Sheets("Mafeuille").Protect ""
 
ActiveWorkbook.SaveAs Chemin & "\" & LieuTravail & " - " & Fonction & " - " & NomAbsent & " - " & Annee & "-" & Mois & ".xls", _
                           FileFormat:=xlNormal, password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
 
FichierSauve = LieuTravail & " - " & Fonction & " - " & NomAbsent & " - " & Annee & "-" & Mois & ".xls"
                        ' <-- Nom du fichier affiché dans la boîte de dialogue.
 
On Error GoTo 0
 
Application.EnableEvents = True
 
OuiNon = MsgBox("Nous sommes le " & Date & " il est  " & Time & " " + Chr$(13) + Chr$(13) + Chr$(13) _
             & "Le fichier est enregistré sous : " & Chemin & "\" + Chr$(13) + Chr$(13) + Chr$(13) _
             & "il se nomme : " & FichierSauve + Chr$(13) + Chr$(13) + Chr$(13) _
             & "Il ne vous reste plus qu'à la transmettre votre demande " + Chr$(13) + Chr$(13) + Chr$(13) + Chr$(13) _
             & "Désirez-vous faire une autre demande ?" + Chr$(13) + Chr$(13) + Chr$(13), _
             vbYesNoCancel + vbQuestion + vbDefaultButton1, "                                        -  LA DEMANDE EST REMPLIE CORRECTEMENT  -          ")
                            ' <-- Mise en forme de la boîte de dialogue d'enregistrement.
 
     If OuiNon = vbYes Then
 
            Range("H33:J33").Select
            Selection.ClearContents
            Range("B33:E33").Select 
            Selection.ClearContents
            Range("J30").Select 
            Selection.ClearContents
            Range("J28").Select
            Selection.ClearContents
            Range("H30").Select 
            Selection.ClearContents
            Range("H28").Select 
            Selection.ClearContents
            Range("F30").Select
            Selection.ClearContents
            Range("F28").Select 
            Selection.ClearContents
            Range("D30").Select
            Selection.ClearContents
            Range("D28").Select 
            Selection.ClearContents
            Range("B30").Select 
            Selection.ClearContents
            Range("B28").Select 
            Selection.ClearContents
            Range("B26:C26").Select 
            Selection.ClearContents
            Range("B23:K23").Select 
            Selection.ClearContents
            Range("B22:K22").Select 
            Selection.ClearContents
            Range("B21:K21").Select 
            Selection.ClearContents
            Range("B20:K20").Select
            Selection.ClearContents
            Range("B19:K19").Select 
            Selection.ClearContents
            Range("B18:K18").Select 
            Selection.ClearContents
             Range("B17:K17").Select 
            Selection.ClearContents
            Range("B16:K16").Select 
            Selection.ClearContents
            Range("B14").Select 
            Selection.ClearContents
            Range("B11:C11").Select 
            Selection.ClearContents
            Range("B10:C10").Select 
            Selection.ClearContents
            Range("B8").Select 
            Selection.ClearContents
            Range("B6:F6").Select
            Selection.ClearContents
            Range("B3:F3").Select 
            Selection.ClearContents         ' <-- Mise à blanc des champs pour la saisie d'une nouvelle demande, la réponse est OUI.
 
ElseIf OuiNon = vbCancel Then
                                                            ' <-- On quitte la boîte de dialogue car la réponse est ANNULE
Else
 
OuiNon = vbNo
           Application.Quit                        ' <-- On quitte Excel car la réponse est NON.
 
End If
 
End Sub

Voilà, c'est un peu compliqué mais la solution doit certainement être plus simple que je pense.

Merci si quelqu'un peut éclairer ma lanterne "