Discussion :

[hortencia]

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]

Bonsoir ...

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

[hortencia]

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]

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]

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]

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é.

[Qwazerty]

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]

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]

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]

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]

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.

[hortencia]

Bonsoir à tous,

Bonsoir Zebreloup,

J'ai créer des classeurs fictifs très simples et peu lourds pour que tu puisse avoir des fichiers tests comme tu me l'as demandé.

J'avais un examen à réviser pour aujourd'hui donc je n'ai pas pu le faire hier, désolé.

Étant donné que c'est la conservation du Classeur et de la feuille déclarée en première partie de macro qui ne fonctionne pas, il faudrait juste que cette partie du code compile, enfin je crois.

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
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
 
 procedureEnCours = False
 
End Sub

Encore une fois, je tiens à te remercier pour l'aide que tu m'apporte et le temps que tu consacre à mon problème.

Très sincèrement.

Merci à tous.
Cordialement.

[ZebreLoup]

Je n'arrive pas du tout à faire le rapprochement entre ton code et les fichiers que tu m'as envoyés. Sachant que tu travailles essentiellement sur la colonne A du Classeur fictif exemple et qu'il n'y a rien dans cette colonne.

Le plus simple est peut-être d'essayer d'expliquer ce que tu veux faire. Je suppose qu'il s'agit d'analyser le fichier "Classeur fictif exemple" et de rajouter dans le classeur principale le nombre de fruits, de viandes et de viennoiseries pour la date concernée ? Non ?
Dans ce cas, il faudrait avoir le format exact du fichier que tu ouvres. Là on ne sait pas à quoi correspondent les chiffres à droite de FRAMBOISE, DINDE, ...

[hortencia]

Bonjour Zebreloup,

Sincèrement, je suis navrée de te donner autant de fourmis dans la tête.

Je t'explique. (PAR RAPPORT A MON CODE DE BASE)
Dans le fichier où il y a les boutons, en colonne A tu as des dates.
En colonne C je fais une somme.
Et sur les colonnes d'après, il y a les catégories (à partir de D)

Dans le classeur que je demande à l'utilisateur d'ouvrir, il y a :
- la date correspondante en "B4" toujours
- en C à partir de la ligne 6 des phrase désignant des catégories.
- en D des montants négatifs et en E des montants positifs.
Sur ce même classeur je lis la colonne C à partir de la ligne 6 et en fonction des mots je tries par catégories en F.
Cependant certaines lignes ne peuvent être classées que par l'utilisateur.
Donc je crées une liste déroulante sur ces dernières, et je souhaite tout arrêter pour que l'utilisateur choisisse les bonnes catégories.

Puis toujours sur ce même classeur, je crées une feuille somme où je somme par catégories.

Et c'est à partir de cette feuille "somme" que je copie colle sur le classeur où il y a les bouton (classeur principale) en fonction des catégories (à partir de la colonne D) et en fonction de la date prise en B4 de l'autre classeur.

Puis en colonne C sur ce même classeur (celui où il y a les boutons) je fais la somme de tout les montants de la ligne (ligne sur laquelle j'ai copie colle les montants, celle correspondante à la date de valeur).

Ceci est l'explication de mon code de départ.
Je ne sais pas si c'est clair.

Désolé en voulant simplifier j'ai surement encore plus compliqué le tout.

Est ce qu'à présent t'arrive à comprendre mon code.
Dis moi.
Surtout si ce n'est pas clair n'hésite pas à me le dire ?
J'ai besoin d'aide, je n'y arriverais jamais je crois.

Merci Zebreloup.
Trés cordialement.

[ZebreLoup]

Voici un fichier que je te propose. Il manque encore quelques trucs que tu devras adapter ou ajouter. Par exemple, je n'ai pas bien compris sous quelle forme tu veux recopier le résultat agrégé par catégorie sur la ligne de ton fichier principal (negatif, positif, les deux, par catégorie...). De même je ne sais pas si tu veux que le fichier ouvert soit sauvé après modification.

J'ai par contre rajouter un onglet dans le fichier principal pour avoir la correspondance produit/catégorie, c'est plus simple que de tout coder en VBA, surtout si tu veux rajouter des correspondances par la suite.

Regarde un peu ça et dis-moi ce qui manque.

[hortencia]

Bonsoir à tous,

Bonsoir Zebrloup,

Je suis contente de voir que tu es encore là.
J'ai encore besoin de tes lumières s'il te plaît.
J'ai posté un message il y a quelques minutes mais je crois qu'il y a eu un beug.

Je teste et reteste ton bouton pour essayer de trouver les exceptions.
Et j'ai remarqué quelque chose.
Lorsque l'on clique sur le bouton, mais que l'on n'ouvre pas de fichier, qu'on annule le lancement ou que l'on a cliqué par erreur sur le bouton par exemple, la macro ne se réinitialise pas.

Le statut du bouton passe à "MODIFS EFFECTUEES" alors que rien à été fait et la macro continu à tourner.
Il faudrait qu'en cas d'erreurs rien ne se passe ou que l'exécution soit réinitialisée.

Sais tu comment je pourrais gérer cette exception s'il ta plaît ??

Cordialement.

[ZebreLoup]

Effectivement, grosse erreur de ma part. Désolé.
Par contre je ne vais pas pouvoir te donner du code pour le moment.
Mais je suis sûr que tu peux y arriver... Il faut que tu transforme la procédure en fonction et qu'elle renvoie si tout s'est bien passé. Un peu comme je l'avais fait pour la fonction d'ouverture de fichier.

[hortencia]

Merci infiniment pour toute ton aide Zebreloup.
Sincèrement.

Je te souhaite de joyeuses fêtes.
Joyeux noël et bonne vacances.
Que de bonnes choses pour cette nouvelle année en venir.

MERCI MERCI.
Cordialement.