Pause dans une macro

**hortencia** · 29/11/2011, 20h43

Bonsoir à tous,

Pourriez vous me venir en aide s'il vous plaît.

J'aimerais savoir comment je pourrais faire pour faire une pause dans une macro.

En fait j'ai une macro qui traite un certains nombres de choses.
Cependant certaines d' entre elles ne peuvent être gérer automatiquement.

Ainsi j'aimerais faire une "pause" à un moment donné au cours de la macro afin que l'utilisateur fasse les ajouts ou des modifications sue le classeur puis que la macro reparte. (en cliquant sur "OK" par exemple)

Quelqu'un aurait t-il une idée ?

Cordialement.

**SfJ5Rpw8** · 29/11/2011, 20h55

Bonsoir ...

tu divise ta macro en 2 et tu lance la deuxième partie par un second bouton ...

**hortencia** · 29/11/2011, 21h34

Merci pour ta réponse bbil.

Mais ne serait-il pas possible de ne garder qu'un seul bouton ?
Suis je contrainte de la couper ?

Cordialement.

**SfJ5Rpw8** · 29/11/2011, 21h51

Déjà faire des macros à rallonge c'est jamais bon ... il faut diviser cela en procédures, fonctions....

après derrière votre bouton vous pouvez mettre une procédure qui teste si la première partie du code à été exécuté et selon le cas lance la première ou la seconde procédure...

**hortencia** · 02/12/2011, 15h42

Merci bien Bbil.

En l'occurrence, il est vrai que ma macro est trés longue.
Mais j'ai beaucoup de mal avec les fonctions et les procédures.
Ma macro marche bien mais je t'avouerais que j'aimerais améliorer la syntaxe.
Il faudrait que je trouve un bon tuto sur les procédures et les fonctions.

Merci encore pour tes conseils.
Cordialement.

Bonjour a tous,

S'IL VOUS PLAIT.
J'ai un soucis avec une macro.
je dois y faire une pause pour faire des modification entre deux evenements
mercadog m'a conseiller de separer ma macro en deux.
et il est clair qu'il a tout a fait raison.

Probleme : comment puis je couper ma macro sans perdre toutes les infos precedentes.
car je reutilise dans la seconde partie des variables de la premiere partie de ma macro.
comment puis je garder ces infos ?
Est ce que si je met des public partout ca peut marcher efficacement?

Cordialement

**d0n32** · 02/12/2011, 17h21

Bonjour,

As-tu essayé de passer en argument les paramètres de ta première moitié de macro ?

En gros, faire une fonction pour ta deuxième moitié de macro, avec comme variables les infos dont tu as besoin et qui sont dans ta première moitié.

**hortencia** · 02/12/2011, 17h38

Bonsoir à tous,

Je suis totalement bloqué.
J'ai crée une macro qui classe des données par catégories.
Je m'explique.

Je lis la colonne A. (il y a des phrases sur les cellules de la colonne A)
S'il y a le mot bananne dans la phrase => je met le mot FRUIT en colonne B.
S'il y a le mot cake dans la phrase => je met le mot GATEAU en colonne B.
...etc

Mais dans certaine cellule de la colonne A, il n'y a pas de mot clé dans les phrase
Ainsi en colonne B, j'ai créé une liste déroulante avec toutes les catégories pour que l'utilisateur puisse choisir la catégorie.

Par la suite ma macro exécute d'autres évènement.

Je voudrais "FAIRE UNE PAUSE" dans la macro à cet instant, pour permettre à l'utilisateur de selectionner via la liste déroulante la catégorie correspondante.

Puis je souhaiterais que la macro reparte. Soit en cliquant sur un bouton soit autrement peu importe.

J'essaye de diviser ma macro en deux macros mais je n'y parvient pas car par la suite j'utilise des variables qu'il y a dans la première partie.

Comment pourrais je faire?
Auriez vous une idée s'il vous plaît.

Cordialement

**defluc** · 02/12/2011, 17h52

Bonjour,
Fournis ta macro pour qu'on puisse y voir plus clair.
A bientôt

Vas aussi voir du côté de la portée des variables qui permet que celles-ci passent d'une procédure à une autre.

**Qwazerty** · 02/12/2011, 18h13

Salut
Et si tu nous montrais de quoi il s'agit, expose ton code pour que l'on puisse te donner un avis plus éclairé.
++
Qwaz

**hortencia** · 06/12/2011, 16h29

Bonjour à tous.

Tout d'abord, je tiens à m'excuser.
Le responsable m'a fait mention du fait que j'avais posté deux fois la même question sur le forum.
Sachez que ceci n'était pas mon intention, veuillez m'en excuseer.
Et navrée pour la gêne occasionnée

De plus, je suis désolé d’avoir mis autant de temps à répondre, je n’avais pas mon code complet, j’ai du aller le récupérer chez mes parents.
Je sais qu’il est surement mal écrit, je suis débutante.
Je n’ai pas encore compris comment fonctionnaient les procédures et les fonctions donc j’ai tous mis en un bloc.
Encore désolé.
Merci infiniment de votre aide à tous.

Voici ce que j'ai fait grace aux tutos et à l'aide des bénévols.
Mais j'ai honte de vous le poster.

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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
Sub SuiviCashBnpEuro()
 
' Déclaration des Variables
Dim i As Integer
Dim S As Variant
 
Dim neg1 As Long
Dim neg2 As Long
Dim neg3 As Long
 
 
Dim pos1 As Long
Dim pos2 As Long
Dim pos3 As Long
 
 
 
 
Dim Wbk1 As Workbook
Dim Wbk2 As Workbook
Dim c As Range
Dim Num_Lig As Long
 
 Set Wbk1 = ThisWorkbook
 
' Choix du fichier 
  Rep = MsgBox("Veuillez choisir le fichier", vbOKCancel, "Chargement du Fichier")
    If Rep = vbCancel Then Exit Sub
    ChDrive ("C")
    ChDir "C:\EMPLACEMENT OU IL Y A LE DOCUMENT A CHOISIR"
 
    fichier = Application.GetOpenFilename("Excel files(*.xls), C:\EMPLACEMENT OU IL Y A LE DOCUMENT*.xls")
 
' Sorti de procédure + Message d'erreurs si fichier non choisi
    On Error GoTo MsgErreurs
    Workbooks.Open Filename:=fichier
 
 
    MsgBox "Le fichier " & x & " est ouvert"
    Set Wbk2 = Workbooks.Open(Filename:=fichier)
 
Cells.Select
Cells.EntireColumn.AutoFit
 
' Renseignement sur le classeur actif
  classeur = ActiveWorkbook.Name
    feuille = ActiveSheet.Name
    DateValeur = Range("B4").Value
 
' Activation de l'autre fichier
  Wbk1.Activate
 
' Recherche de la ligne à incrémenter en fonction de la date de valeur
With Sheets("Feuil1")
    Set c = .Range("A:A").Find(DateValeur, LookIn:=xlValues, lookat:=xlWhole)
     If Not c Is Nothing Then
             Num_Lig = c.Row
             Set c = Nothing
        End If
    If Num_Lig > 0 Then
                MsgBox Num_Lig
    Else
                MsgBox "Date inéxistante"
        End If
 
End With
 
' Activation du fichier choisi
Wbk2.Activate
 
'Compteur du nombre de ligne à balayer (ie: cellules pleines)
S = Application.WorksheetFunction.CountA(Range("A:A"))
 
'Balayage de la plage de données et Classement selon catégories
For i = 6 To S Step 1
 
If InStr(1, Cells(i, 3).Value, "FRAMBOISE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "MURE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "FRAISE", vbTextCompare) <> 0 Then
        Cells(i, 6).Value = "FRUIT"
 
Else
If InStr(1, Cells(i, 3).Value, "CROISSANT", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "VIENNOISE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "CHOUCREME", vbTextCompare) <> 0 Then
        Cells(i, 6).Value = "VIENNOISERIE"
 
Else
If InStr(1, Cells(i, 3).Value, "PORC", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "BOEUF", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "DINDE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "VOLAILLE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "POULET", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "AGNEAU", vbTextCompare) <> 0 Then
        Cells(i, 6).Value = "VIANDE"
 
' ETCETERA CAR IL Y A BCP DE CATEGORIES
Else
        Cells(i, 6).Value = "A CLASSER"
 
End If
End If
End If
End If
 
 
Next i
 
 
'Tri par ordre alphabétique
    Range("A6:F" & S).Select
    Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
 
'Création de listes déroulantes concernant les A CLASSER 
 
For i = 6 To S Step 1
If Range("F" & i) = "A CLASSER" Then
Range("F" & i).Select
 
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="FRUIT,VIENNOISERIE,VIANDE"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If
Next i
 
'C'EST ICI QUE JE VOUDRAIS METTRE UN CLIVAGE POUR QUE L'UTILISATEUR SELECTIONNE DANS LES LISTES DEROULANTES DES CATEGORIES A CLASSER LA BONNE CATEGORIE
 
'Tri par ordre alphabétique
    Range("A6:F" & S).Select
    Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
 
 
'Somme par catégories
For i = 6 To S Step 1
On Error Resume Next
 
    If Cells(i, 6).Value = "FRUIT" Then
 
            neg1 = neg1 + Val((Cells(i, 4)))
            pos1 = pos1 + Val((Cells(i, 5)))
 
    Else
    If Cells(i, 6).Value = "VIENNOISERIE" Then
 
          neg2 = neg2 + Val((Cells(i, 4)))
          pos2 = pos2 + Val((Cells(i, 5)))
 
    Else
    If Cells(i, 6).Value = "VIANDE" Then
 
            neg3 = neg3 + Val((Cells(i, 4)))
            pos3 = pos3 + Val((Cells(i, 5)))
 
 
'ETCETERA
 
    End If
    End If
    End If
 
Next i
 
 
' Création d'une nouvelle feuille nommée Somme
Sheets.Add.Move after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Somme"
 
ActiveCell.FormulaR1C1 = "CATEGORIES"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "FRUIT"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "VIENNOISERIE"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "VIANDE"
    Range("A5").Select
 
 
 
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "NEGATIF"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "POSITIF"
 
    Range("B2,B9").Select
     With Selection.Interior
             .ColorIndex = 27
             .Pattern = xlSolid
                 .PatternColorIndex = xlAutomatic
        End With
    Range("C5:C8").Select
        With Selection.Interior
             .ColorIndex = 46
                .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
 
 
' Tableau des montants par catégories
Cells(2, 2) = neg1
Cells(3, 2) = neg2
Cells(4, 2) = neg3
 
 
 
Cells(2, 3) = pos1
Cells(3, 3) = pos2
Cells(4, 3) = pos3
 
'ETCETERA
 
 
Cells.Select
Cells.EntireColumn.AutoFit
 
ActiveWorbook.Save
 
'COPIE SUR L'AUTRE CLASSEUR
  Set Wbk1 = ThisWorkbook
 
 
If Range("C2") <> 0 Then
Wbk2.Sheets("Somme").Range("C2").Copy _
    Destination:=Wbk1.ActiveSheet.Range("J" & Num_Lig)
End If
 
If Range("B3") <> 0 Then
Wbk2.Sheets("Somme").Range("B3").Copy _
    Destination:=Wbk1.ActiveSheet.Range("" & Num_Lig)
End If
 
If Range("C3") <> 0 Then
Wbk2.Sheets("Somme").Range("C3").Copy _
    Destination:=Wbk1.ActiveSheet.Range("K" & Num_Lig)
End If
 
If Range("B4") <> 0 Then
Wbk2.Sheets("Somme").Range("B4").Copy _
    Destination:=Wbk1.ActiveSheet.Range("I" & Num_Lig)
End If
 
If Range("C4") <> 0 Then
Wbk2.Sheets("Somme").Range("C4").Copy _
    Destination:=Wbk1.ActiveSheet.Range("M" & Num_Lig)
End If
 
If Range("B5") <> 0 Then
Wbk2.Sheets("Somme").Range("B5").Copy _
    Destination:=Wbk1.ActiveSheet.Range("D" & Num_Lig)
End If
 
If Range("B6") <> 0 Then
Wbk2.Sheets("Somme").Range("B6").Copy _
    Destination:=Wbk1.ActiveSheet.Range("F" & Num_Lig)
End If
 
 
If Range("B7") <> 0 Then
Wbk2.Sheets("Somme").Range("B7").Copy _
    Destination:=Wbk1.ActiveSheet.Range("H" & Num_Lig)
End If
 
If Range("B8") <> 0 Then
Wbk2.Sheets("Somme").Range("B8").Copy _
    Destination:=Wbk1.ActiveSheet.Range("E" & Num_Lig)
End If
 
If Range("C9") <> 0 Then
Wbk2.Sheets("Somme").Range("C9").Copy _
    Destination:=Wbk1.ActiveSheet.Range("L" & Num_Lig)
End If
 
If (Range("C10") <> 0 And Range("B10") <> 0) Then
Range("B10") = Range("B10") * (-1)
Range("B10").Select
    With Selection.Font
        .ColorIndex = 3
    End With
Wbk1.ActiveSheet.Range("N" & Num_Lig) = Wbk2.Sheets("Somme").Range("B10").Value + Wbk2.Sheets("Somme").Range("C10").Value
 
Else
If Range("B10") <> 0 Then
Range("B10") = Range("B10") * (-1)
Range("B10").Select
    With Selection.Font
        .ColorIndex = 3
    End With
Wbk2.Sheets("Somme").Range("B10").Copy _
    Destination:=Wbk1.ActiveSheet.Range("N" & Num_Lig)
Else
If Range("C10") <> 0 Then
Wbk2.Sheets("Somme").Range("C10").Copy _
    Destination:=Wbk1.ActiveSheet.Range("N" & Num_Lig)
 
End If
End If
End If
 
Wbk1.Activate
 
 
    Cells.Select
Cells.EntireColumn.AutoFit
 
' Message d'erreurs si problème d'ouverture du fichier
Exit Sub 'Arrête la procédure pour éviter le message
 
MsgErreurs:
 
    MsgBox "Il faut sélectionner un fichier"
 
 
End Sub

Très cordialement.

**ZebreLoup** · 06/12/2011, 17h02

Je dirais 2 pistes :
1- Tu fais un userForm à la place de ta liste de validation
2- Tu déclares tes variables en globales et tu sépares ton code en 2. Tu rajoutes une variable globale que tu mets à False à l'ouverture du classeur, à True à la fin de la première partie de ton code, et à False à la fin de la deuxième partie. Sur l'évènement Worksheet_Change de ta feuille, s'il s'agit de la cellule soumise à la validation (la liste), tu déclenches la deuxième macro seulement si ta nouvelle variable est à True. J'espère que c'est à peu près clair.

**hortencia** · 06/12/2011, 17h04

Merci de ta réponse Zebreloup.
Mais je ne sais pas comment faire ce genre de choses.

Trés cordialement.

**ZebreLoup** · 06/12/2011, 17h21

En relisant un peu plus ton code, la première solution parait compliquée en l'état étant donné qu'il y a plusieurs liste de choix.
Pour la deuxième solution, au lieu de faire des

Code :

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

Dim neg1 As Long

dans ta procédure, tu fais

Code :

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

Public neg1 As Long

Au début d'un module. Au même endroit, tu peux rajouter un

Code :

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

Public procedureEnCours As Boolean

De ce fait, quand tu exécuteras ta deuxième macro (après avoir vérifier que la première a bien été exécutée via procedureEnCours), tu auras conservé la valeur de tes variables entre les deux.

Voici ce que tu pourrais faire. Je n'ai pas vérifier tout ton code, juste s'il compilait.

Dans un module (modifs en rouge)

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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
Option Explicit

Public S As Variant

Public neg1 As Long
Public neg2 As Long
Public neg3 As Long
 
Public pos1 As Long
Public pos2 As Long
Public pos3 As Long

Public Wbk2 As Workbook
Public Num_Lig As Long

Public procedureEnCours  As Boolean

Sub SuiviCashBnpEuro1()
 
' Déclaration des Variables
Dim i As Integer
 
 
'variables rajoutées pour que ça compile
Dim Rep As VbMsgBoxResult
Dim fichier As String
Dim classeur As String
Dim feuille As String
Dim DateValeur As Variant

Dim Wbk1 As Workbook
Dim c As Range
 
 Set Wbk1 = ThisWorkbook
 
' Choix du fichier
  Rep = MsgBox("Veuillez choisir le fichier", vbOKCancel, "Chargement du Fichier")
    If Rep = vbCancel Then Exit Sub
    ChDrive ("C")
    ChDir "C:\EMPLACEMENT OU IL Y A LE DOCUMENT A CHOISIR"
 
    fichier = Application.GetOpenFilename("Excel files(*.xls), C:\EMPLACEMENT OU IL Y A LE DOCUMENT*.xls")
 
' Sorti de procédure + Message d'erreurs si fichier non choisi
    On Error GoTo MsgErreurs
    Workbooks.Open Filename:=fichier
 
 
    MsgBox "Le fichier " & fichier & " est ouvert"
    Set Wbk2 = Workbooks.Open(Filename:=fichier)
 
Cells.Select
Cells.EntireColumn.AutoFit
 
' Renseignement sur le classeur actif
  classeur = ActiveWorkbook.Name
    feuille = ActiveSheet.Name
    DateValeur = Range("B4").Value
 
' Activation de l'autre fichier
  Wbk1.Activate
 
' Recherche de la ligne à incrémenter en fonction de la date de valeur
With Sheets("Feuil1")
    Set c = .Range("A:A").Find(DateValeur, LookIn:=xlValues, lookat:=xlWhole)
     If Not c Is Nothing Then
             Num_Lig = c.Row
             Set c = Nothing
        End If
    If Num_Lig > 0 Then
                MsgBox Num_Lig
    Else
                MsgBox "Date inéxistante"
        End If
 
End With
 
' Activation du fichier choisi
Wbk2.Activate
 
'Compteur du nombre de ligne à balayer (ie: cellules pleines)
S = Application.WorksheetFunction.CountA(Range("A:A"))
 
'Balayage de la plage de données et Classement selon catégories
For i = 6 To S Step 1
 
If InStr(1, Cells(i, 3).Value, "FRAMBOISE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "MURE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "FRAISE", vbTextCompare) <> 0 Then
        Cells(i, 6).Value = "FRUIT"
 
ElseIf InStr(1, Cells(i, 3).Value, "CROISSANT", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "VIENNOISE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "CHOUCREME", vbTextCompare) <> 0 Then
        Cells(i, 6).Value = "VIENNOISERIE"
 
ElseIf InStr(1, Cells(i, 3).Value, "PORC", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "BOEUF", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "DINDE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "VOLAILLE", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "POULET", vbTextCompare) Or InStr(1, Cells(i, 3).Value, "AGNEAU", vbTextCompare) <> 0 Then
        Cells(i, 6).Value = "VIANDE"
 
' ETCETERA CAR IL Y A BCP DE CATEGORIES
Else
        Cells(i, 6).Value = "A CLASSER"
 
End If

 
Next i
 
 
'Tri par ordre alphabétique
    Range("A6:F" & S).Select
    Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
 
'Création de listes déroulantes concernant les A CLASSER
 
For i = 6 To S Step 1
If Range("F" & i) = "A CLASSER" Then
Range("F" & i).Select
 
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="FRUIT,VIENNOISERIE,VIANDE"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If
Next i

  procedureEnCours = True


' Message d'erreurs si problème d'ouverture du fichier
Exit Sub 'Arrête la procédure pour éviter le message
 
MsgErreurs:
 
    MsgBox "Il faut sélectionner un fichier"
 

End Sub


Sub SuiviCashBnpEuro2()

Dim i As Integer
Dim Wbk1 As Workbook

'C'EST ICI QUE JE VOUDRAIS METTRE UN CLIVAGE POUR QUE L'UTILISATEUR SELECTIONNE DANS LES LISTES DEROULANTES DES CATEGORIES A CLASSER LA BONNE CATEGORIE
 'pense à redéfinir Wbk1
 
'Tri par ordre alphabétique
    Range("A6:F" & S).Select
    Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
 
 
'Somme par catégories
For i = 6 To S Step 1
On Error Resume Next
 
    If Cells(i, 6).Value = "FRUIT" Then
 
            neg1 = neg1 + Val((Cells(i, 4)))
            pos1 = pos1 + Val((Cells(i, 5)))
 
    Else
    If Cells(i, 6).Value = "VIENNOISERIE" Then
 
          neg2 = neg2 + Val((Cells(i, 4)))
          pos2 = pos2 + Val((Cells(i, 5)))
 
    Else
    If Cells(i, 6).Value = "VIANDE" Then
 
            neg3 = neg3 + Val((Cells(i, 4)))
            pos3 = pos3 + Val((Cells(i, 5)))
 
 
'ETCETERA
 
    End If
    End If
    End If
 
Next i
 
 
' Création d'une nouvelle feuille nommée Somme
Sheets.Add.Move after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Somme"
 
ActiveCell.FormulaR1C1 = "CATEGORIES"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "FRUIT"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "VIENNOISERIE"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "VIANDE"
    Range("A5").Select
 
 
 
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "NEGATIF"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "POSITIF"
 
    Range("B2,B9").Select
     With Selection.Interior
             .ColorIndex = 27
             .Pattern = xlSolid
                 .PatternColorIndex = xlAutomatic
        End With
    Range("C5:C8").Select
        With Selection.Interior
             .ColorIndex = 46
                .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
 
 
' Tableau des montants par catégories
Cells(2, 2) = neg1
Cells(3, 2) = neg2
Cells(4, 2) = neg3
 
 
 
Cells(2, 3) = pos1
Cells(3, 3) = pos2
Cells(4, 3) = pos3
 
'ETCETERA
 
 
Cells.Select
Cells.EntireColumn.AutoFit
 
ActiveWorkbook.Save
 
'COPIE SUR L'AUTRE CLASSEUR
  Set Wbk1 = ThisWorkbook
 
 
If Range("C2") <> 0 Then
Wbk2.Sheets("Somme").Range("C2").Copy _
    Destination:=Wbk1.ActiveSheet.Range("J" & Num_Lig)
End If
 
If Range("B3") <> 0 Then
Wbk2.Sheets("Somme").Range("B3").Copy _
    Destination:=Wbk1.ActiveSheet.Range("" & Num_Lig)
End If
 
If Range("C3") <> 0 Then
Wbk2.Sheets("Somme").Range("C3").Copy _
    Destination:=Wbk1.ActiveSheet.Range("K" & Num_Lig)
End If
 
If Range("B4") <> 0 Then
Wbk2.Sheets("Somme").Range("B4").Copy _
    Destination:=Wbk1.ActiveSheet.Range("I" & Num_Lig)
End If
 
If Range("C4") <> 0 Then
Wbk2.Sheets("Somme").Range("C4").Copy _
    Destination:=Wbk1.ActiveSheet.Range("M" & Num_Lig)
End If
 
If Range("B5") <> 0 Then
Wbk2.Sheets("Somme").Range("B5").Copy _
    Destination:=Wbk1.ActiveSheet.Range("D" & Num_Lig)
End If
 
If Range("B6") <> 0 Then
Wbk2.Sheets("Somme").Range("B6").Copy _
    Destination:=Wbk1.ActiveSheet.Range("F" & Num_Lig)
End If
 
 
If Range("B7") <> 0 Then
Wbk2.Sheets("Somme").Range("B7").Copy _
    Destination:=Wbk1.ActiveSheet.Range("H" & Num_Lig)
End If
 
If Range("B8") <> 0 Then
Wbk2.Sheets("Somme").Range("B8").Copy _
    Destination:=Wbk1.ActiveSheet.Range("E" & Num_Lig)
End If
 
If Range("C9") <> 0 Then
Wbk2.Sheets("Somme").Range("C9").Copy _
    Destination:=Wbk1.ActiveSheet.Range("L" & Num_Lig)
End If
 
If (Range("C10") <> 0 And Range("B10") <> 0) Then
Range("B10") = Range("B10") * (-1)
Range("B10").Select
    With Selection.Font
        .ColorIndex = 3
    End With
Wbk1.ActiveSheet.Range("N" & Num_Lig) = Wbk2.Sheets("Somme").Range("B10").Value + Wbk2.Sheets("Somme").Range("C10").Value
 
Else
If Range("B10") <> 0 Then
Range("B10") = Range("B10") * (-1)
Range("B10").Select
    With Selection.Font
        .ColorIndex = 3
    End With
Wbk2.Sheets("Somme").Range("B10").Copy _
    Destination:=Wbk1.ActiveSheet.Range("N" & Num_Lig)
Else
If Range("C10") <> 0 Then
Wbk2.Sheets("Somme").Range("C10").Copy _
    Destination:=Wbk1.ActiveSheet.Range("N" & Num_Lig)
 
End If
End If
End If
 
Wbk1.Activate
 
 
    Cells.Select
Cells.EntireColumn.AutoFit
 
 procedureEnCours = False
 
End Sub

Dans thisWorkbook

Code :

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

1
2
3
Private Sub Workbook_Open()
    procedureEnCours = False
End Sub

Dans la feuille qui contient la cellules ou l'utilisateur doit faire un choix

Code :

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

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
    If procedureEnCours Then
        If Target.Column = 6 And Target.Row >= 6 And Target.Row <= S Then
            SuiviCashBnpEuro2
        End If
    End If
End Sub

**hortencia** · 06/12/2011, 18h17

Merci beaucoup de ton aide Zebreloup,

Mais je crois voir une limite :

Comment puis je mettre la procédure Worksheet_Change dans la feuille où l'utilisateur doit faire le choix sachant que ce fichier est toujours différent.

C'est un fichier que l'on choisit???

Je ne comprends pas bien Zebreloup ????
Excuse moi, peux tu m'éclairer ?

**Qwazerty** · 06/12/2011, 22h27

Salut

Je me suis plus penché sur le code en lui même, pas sur l'organisation de ta séparation de code.

Voila quelques modifications et simplifications (pas testé) pour la 1ere partie de ton code.

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
Dim Fichier As String
Dim TheCell As Range
 
    Set Wbk1 = ThisWorkbook
 
    'Je ne suis pas sûr que cette partie fonctionne bien, je te laisse voir ce que tu veux faire
    ' Choix du fichier
    Rep = MsgBox("Veuillez choisir le fichier", vbOKCancel, "Chargement du Fichier")
    If Rep = vbCancel Then Exit Sub
    ChDrive ("C")
    ChDir "C:\EMPLACEMENT OU IL Y A LE DOCUMENT A CHOISIR"
 
    Fichier = Application.GetOpenFilename("Excel files(*.xls), C:\EMPLACEMENT OU IL Y A LE DOCUMENT*.xls")
 
    ' Sorti de procédure + Message d'erreurs si fichier non choisi
    On Error Resume Next
    Set Wbk2 = Workbooks.Open(Filename:=Fichier)
    On Error GoTo 0
 
    'MsgBox "Le fichier " & x & " est ouvert"
    'Workbooks.Open(Filename:=fichier)
    'On vérifie que l'utilisateur a bien choisi un fichier et que celui-ci c'est bien ouvert
    If Wbk2 Is Nothing Then
        MsgBox "Problème avec le fichier"
        Exit Sub
    End If
 
    'Lorsque tu travailles avec plusieur Classeur / Feuilles il faut toujours préciser sur quoi tu travailles
    'précise la feuille
    'UsedRange permet de ne faire référence qu'aux cellules utilisées sur ta feuille, ça limite le nombre de cellule
    Wbk2.Sheets("????").UsedRange.EntireColumn.AutoFit 'Cells.Select
    'Cells.EntireColumn.AutoFit
 
    ' Renseignement sur le classeur actif
    classeur = Wbk2.Name
    feuille = Wbk2.Name
    DateValeur = Wbk2.Sheets("????").Range("B4").Value
 
    ' Activation de l'autre fichier
    'Wbk1.Activate 'Inutile, il suffira de toujours bien placer WbK1 pour spécifier que tu veux travailler sur ce classeur
 
    ' Recherche de la ligne à incrémenter en fonction de la date de valeur
    With Wbk1.Sheets("Feuil1")
        Set c = .Range("A:A").Find(DateValeur, LookIn:=xlValues, lookat:=xlWhole)
         If Not c Is Nothing Then
                 Num_Lig = c.Row
                 Set c = Nothing
            End If
        If Num_Lig > 0 Then
                    MsgBox Num_Lig
        Else
                    MsgBox "Date inéxistante"
            End If
 
    End With
 
    ' Activation du fichier choisi
    'Wbk2.Activate
 
    'On boucle sur les cellule de la colonne A jusqu'a la derniere cellule non vide
    For Each TheCell In Wbk2.Range("A6", Wbk2.Cells(Wbk2.Rows.Count, "A").End(xlUp))
        'Si on suppose que tes cellule ne contienent que le texte recherché (par exemple "Framboise")
        Select Case TheCell.Offset(0, 2).Value
            Case "FRAMBOISE", "MURE", "FRAISE"
                TheCell.Offset(0, 5).Value = "FRUIT"
            Case "CROISSANT", "VIENNOISE", "CHOUCREME"
                TheCell.Offset(0, 5).Value = "VIENNOISERIE"
            Case "PORC", "BOEUF", "DINDE", "VOLAILLE", "POULET", "AGNEAU"
                TheCell.Offset(0, 5).Value = "VIANDE"
            Case Else
                TheCell.Offset(0, 5).Value = "A CLASSER"
                'Et on place la liste déroulante
                With TheCell.Offset(0, 5).Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="FRUIT,VIENNOISERIE,VIANDE"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ShowInput = True
                    .ShowError = True
                End With
        End Select
 
    Next
 
 
'Tri par ordre alphabétique
    Wbk2.Range("A6:F" & Wbk2.Cells(Wbk2.Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

++
Qwaz

**hortencia** · 06/12/2011, 22h29

Bonsoir tous le monde,

Est ce que quelqu'un aurait une idée ? ou alors une suggestion par rapport à l'idée de Zebreloup ?

Trés cordialement.

**ZebreLoup** · 07/12/2011, 09h08

Je n'avais pas fait attention au fait que les listes étaient dans le fichier que tu ouvres. Dans ce cas, peut-être qu'un deuxième bouton dans le fichier principal est une bonne solution.
Tu peux bien sûr rajouter dynamiquement du code dans le fichier ouvert, mais c'est un peu plus compliqué si tu débutes en VBA.

**hortencia** · 07/12/2011, 10h11

Merci de ta réponse Zebreloup,

J'essaye lamentablement de trouver comment créer deux bouton et séparer la macro pour que cela fonctionne mais je n'y parvient pas.

Est ce que tu sais comment je dois faire pour que cela fonctionne ?

Ps : Merci infiniment de ton aide.

Cordialement.

Je voudrais couper la macro en deux pour que l'utilisateur ait la main au moment que j'ai indiquer dans le code, peut importe le moyen utilisé.

J'aimerais bien créer deux bouton sur mon classeur principal, ce serait l'idéal mais je ne sais pas comment faire.

Merci encore.
Cordialement.

**ZebreLoup** · 07/12/2011, 10h12

Je pense que la manière dont je l'avais coupé devrait convenir. Mais tu lances la deuxième procédure via un bouton plutôt que dans l'évènement Worksheet_Change.

Pour lancer une macro via un bouton, tu créés un bouton via la boite à outils contrôles, te le personnalises (nom, apparence, ...) et tu double-clique dessus. Tu te retrouve dans l'évènement NomDuBouton_Click de ta feuille et c'est là que tu appelles ta macro (il suffit d'écrire le nom de ta macro)