Discussion :

[ZebreLoup]

Et n'oublie pas de regarder ce que t'avais proposé Qwazerty pour simplifier un peu ton code.

Si ça peut t'aider, j'ai modifié un peu ton code actuel. J'avoue que j'ai laissé tomber au bout d'un moment car je n'arrivais plus à deviner ce que tu essayais de faire, mais ça peut t'aider à progresser en VBA je pense.

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
Option Explicit
 
Public numLigneDate As Long
Public nbLignes As Long
Public wbOuvert As Workbook
Public wsOuvert As Worksheet
 
Public procedureEnCours  As Boolean
 
Private Const CHEMIN_FICHIERS As String = "D:\DONNEES\SLEROUX"
 
'Ouvre un fichier et l'atribut
Private Function OuvertureFichier(ByRef wb As Workbook) As Boolean
    Dim res As Boolean
    Dim fd As FileDialog
    Dim fichier As String
 
    res = False
 
    Set fd = Application.FileDialog(msoFileDialogOpen)
 
    fd.Filters.Clear
    fd.Filters.Add "Fichier Excel", "*.xls; *.xlsx; *.xlsm"
    fd.AllowMultiSelect = False
    fd.InitialFileName = CHEMIN_FICHIERS
 
    If fd.Show = -1 Then
        fichier = fd.SelectedItems(1)
    End If
 
    On Error Resume Next
    Set wb = Workbooks.Open(fichier)
    If Err.Number = 0 Then res = True Else MsgBox "Erreur à l'ouverture du fichier"
    On Error GoTo 0
 
    OuvertureFichier = res
End Function
 
'Donne le type en fonction du contenu
'S'il y a beaucoup de catégorie, il faudra peut-être faire une table de correspondance dans ton fichier
' et l'utiliser
Private Function GetTypeContenu(ByVal contenu As String) As String
    Select Case contenu
    Case "FRAMBOISE", "MURE", "FRAISE"
        GetTypeContenu = "FRUIT"
    Case "CROISSANT", "VIENNOISE", "CHOUCREME"
        GetTypeContenu = "VIENNOISERIE"
    Case "PORC", "BOEUF", "DINDE", "VOLAILLE", "POULET", "AGNEAU"
        GetTypeContenu = "VIANDE"
    Case Else
        GetTypeContenu = "A CLASSER"
    End Select
End Function
 
'Première partie de la macro
Public Sub SuiviCashBnpEuro1()
    Dim wbActuel As Workbook
    Dim wsActuel As Worksheet
 
    Dim dateValeur As Date
    Dim rgDate As Range
    Dim i As Integer
    Dim typeObjet As String
 
    'On définit le classeur actuel
    Set wbActuel = ThisWorkbook
    Set wsActuel = wbActuel.Worksheets(1)
        'J'ai l'impression que tu n'utilises que la première feuille
 
    'Ouverture du fichier
    Dim wbOuvert As Workbook
    If Not OuvertureFichier(wbOuvert) Then Exit Sub
    Set wsOuvert = wbOuvert.Worksheets(1)
        'J'ai l'impression que tu n'utilises que la première feuille
 
    'Autofit du fichier ouvert
    wsOuvert.UsedRange.EntireColumn.AutoFit
 
    'On récupère la date valeur
    dateValeur = wsOuvert.Range("B4").Value
 
    'Recherche de la ligne à incrémenter en fonction de la date de valeur
    Set rgDate = wsActuel.Columns("A").Find(dateValeur, LookIn:=xlValues, lookat:=xlWhole)
    If c Is Nothing Then
        MsgBox "Date inexistante"
        Exit Sub
    End If
    numLigneDate = c.Row
 
    'Compteur du nombre de ligne à balayer (ie: cellules pleines)
    nbLignes = wsOuvert.Cells(wsOuvert.Cells.Count, 1).End(xlUp).Row
 
    For i = 6 To nbLignes 'Pour chaque ligne
        'On cherche le contenu
        typeObjet = GetTypeContenu(wsOuvert.Cells(i, 3).Value)
        wsOuvert.Cells(i, 6).Value = typeObjet
 
        'Si c'est à classer, on créé la liste déroulante
        If typeObjet = "A CLASSER" Then
            With wsOuvert.Cells(i, 6).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="FRUIT,VIENNOISERIE,VIANDE"
                .IgnoreBlank = True
                .InCellDropdown = True
                .ShowInput = True
                .ShowError = True
            End With
        End If
    Next i
 
    'La procédure est terminée on pourra relancer
    procedureEnCours = True
 
End Sub
 
'Deuxième partie de la macro
Sub SuiviCashBnpEuro2()
    Dim neg(2) As Double
    Dim pos(2) As Double
 
    'Tri par ordre alphabétique
    wsOuvert.Range("A6:F" & nbLignes).Sort Key1:=wbOuvert.Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    'Somme par catégories
    For i = 6 To nbLignes
        Select Case wsOuvert.Cells(i, 6).Value
        Case "FRUIT"
            neg(0) = neg(0) + wsOuvert.Cells(i, 4).Value
            pos(0) = pos(0) + wsOuvert.Cells(i, 5).Value
        Case "VIENNOISERIE"
            neg(1) = neg(1) + wsOuvert.Cells(i, 4).Value
            pos(1) = pos(1) + wsOuvert.Cells(i, 5).Value
        Case "VIANDE"
            neg(2) = neg(2) + wsOuvert.Cells(i, 4).Value
            pos(2) = pos(2) + wsOuvert.Cells(i, 5).Value
        End Select
    Next i
 
    'Création d'une nouvelle feuille nommée Somme
    Dim wsSomme As Worksheet
    Set wsSomme = wbOuvert.Worksheets.Add(after:=wbOuvert.Worksheets.Count)
    wsSomme.Name = "Somme"
 
    wsSomme.Range("A1").Value = "CATEGORIES"
 
    wsSomme.Range("A2").Value = "FRUIT"
    wsSomme.Range("A3").Value = "VIENNOISERIE"
    wsSomme.Range("A4").Value = "VIANDE"
 
    wsSomme.Range("B1").Value = "NEGATIF"
    wsSomme.Range("C1").Value = "POSITIF"
 
    For i = 0 To 2
        wsSomme.Cells(i + 1, 2).Value = neg(i)
        wsSomme.Cells(i + 1, 3).Value = pos(i)
    Next i
 
    wsSomme.Range("B2:B9").Interior.ColorIndex = 27
    wsSomme.Range("C5:C8").Interior.ColorIndex = 46
 
    wsSomme.UsedRange.EntireColumn.AutoFit
 
    wbOuvert.Save
 
    'COPIE SUR L'AUTRE CLASSEUR
    'Là, j'avoue que je suis un peu perdu sur ce que tu voulais faire
    'Qu'est-ce que tu copies sur quoi ?
    'C'est le problème des activate, on ne sait plus où on en est
    'En tout cas, tu dois pouvoir copier toute une plage d'un coup plutôt que de faire tous tes Copy
 
    procedureEnCours = False
 
End Sub

[hortencia]

Bonsoir Quazerty,

Merci de ton aide.
Figure toi que je ne l'avais même pas vu.
Il est clair que mon code est vraiment trop lourd!!!!
Cela va m'aider.

Bonsoir Zebreloup,

Merci infiniment de toute ton aide et de tes éclaircissement.
Dis moi si j'ai bien compris parce que je n'arrive pas à le faire fonctionner.

Sur mon classeur, je créer deux bouton =>

Dans le 1er bouton :

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 le 2eme bouton :

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

Dans This Workbook,

Code :

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

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

Est ce que c'est ce que je dois faire ?

Ainsi en clickant sur le premer bouton les événements s'enchaine jusque l'endroit où j'ai spécifié le clivage.
Puis tout s'arrête, l'utilisateur sélectionne dans la liste déroulante chaque catégorie manquante.
Ensuite en clickant sur le deuxième bouton les événements du bouton 1 se poursuive.

Est ce comme cela ?
Ou n'ai je pas bien compris encore?

Cordialement
PS: Vraiment MERCI POUR VOTRE AIDE CAR JE NE M'EN SORTIRAIS JAMAIS SEULE.

Bonsoir,

Apparemment, c'est l'évènement Worksheet_Change qui pose problème.

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

Mais j'ai vu que Zebreloup m'avais envoyé un message concernant cela.
Je cite :
"Tu lances la deuxième procédure via un bouton plutôt que dans l'évènement Worksheet_Change."

Je suis trop nul je ne vois pas ce qu'il faut faire ?
Moi j'ai mis le tout dans le 2ème bouton.
Quelqu'un saurait quelle est la modification que je dois faire ?

Cordialement.

PS : Zebreloup, les modifications que tu as faites pour améliorer mon code vont certainement beaucoup m'aider à progresser et à apprendre à coder correctement.

Merci.

Dés que j'aurais réussi à cliver la macro de manière efficace je me plongerais dessus pour améliorer le tout.

Merci à vous tous.

Si quelqu'un à la lumière sur le blocage que je fais sur le clivage que m'a proposé Zebreloup...

Trés Cordialement.

[ZebreLoup]

Mon idée du worksheet_change était vraiment au début, je n'avais pas pris en compte le fait que ce soit sur le fichier que tu ouvrais et que plusieurs cellules étaient concernées. C'est l'évènement qui se déclenche quand tu modifies un valeur dans une cellule.

Il faut donc mieux, soit créer deux boutons et vérifier au click du deuxième que la variable procedureEnCours est bien à True. Soit un seul bouton qui fait la première partie si procedureEnCours = False et la deuxième si procedureEnCours = True.
Tout le code que je t'ai donné doit être dans un module (il y avait peut-être quelques petites erreurs encore, je n'ai pas vraiment testé, n'ayant pas le format de tes fichiers sources). Ensuite tu crées dans une feuille un bouton via la boite à outils contrôles et si tu double-clique dessus, tu verras apparaitre le code MonBouton_Click (ou MonBouton est le nom du bouton). C'est la dedans que tu vas appeler les procédures que je t'ai envoyée.

[hortencia]

Merci Zebreloup.

Alors dans un bouton j'ai mis les deux procédure que tu m'as modifié (mais pour l'instant ça ne compile pas, je cherche à déboguer).

J'ai créer un deuxième bouton comme tu me l'a dit mais je ne sais pas ce que je dois y mettre.
Dois je y mettre ce code :

Code :

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

1
2
3
4
5
Private Sub Macro1()
    If (procedureEnCours == True) Then
            SuiviCashBnpEuro2
        End If
End Sub

Désolé je dois vraiment t'embêter avec mes questions trés minimalistes.

Cordialement, Laura.

[ZebreLoup]

C'est exactement ça si tu utilises des boutons de type "Formulaire", tu associes Macro1 à ton bouton.
Si tu utilises des boutons de type "Contrôles", il faut mettre le code que tu viens d'écrire dans MonBouton_Click dans la feuille qui contient le bouton plutôt que dans Macro1 dans un module.
Tu peux générer automatique la déclaration de ce code soit en double-cliquant sur le bouton quand il est en mode édition, soit en allant dans le code de la feuille qui le contient et juste au dessus du code, tu choisis ton bouton à la place de "General" dans la partie de gauche et l'évènement "Click" dans la partie de droite s'il n'a pas été choisi automatiquement

[hortencia]

Bonjour à tous,

Bonjour Zebreloup,

Super je suis contente je commence à comprendre un peu je crois.
J'ai débogué le code de ma première macro grâce à tes indications sur la manière de coder.

C'est génial.

Mai là je suis bloque la deuxième ne fonctionne pas.
Figure toi qu'elle ne démarre même pas.
Encore une ignorance de ma part surement!!!!

Cela bloque dès le début.
Un message m'indique Variable Objet ou variable de bloc With non défini :

Code :

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

1
2
3
wsOuvert.Range("A6:F" & nbLignes).Sort Key1:=wbOuvert.Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

J'ai cherché sur internet et sur le forum :
Lorsque l'on a cette erreur c'est parce que l'on a pas déclarez la variable objet, ou on ne la pas référencer avec l'instruction .

En l’occurrence je crois comprendre que c'est la variable wsOuvert qu'il ne connait pas.

Et c'est là où je bloque.

Le fait d'avoir mis les deux procédures dans le même module et d'avoir mis wsOuvert en public ne devrait-il pas être efficace?

Code :

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

1
2
3
4
5
6
Option Explicit
 
Public numLigneDate As Long
Public nbLignes As Long
Public wbOuvert As Workbook
Public wsOuvert As Worksheet

Merci encore.
Cordialement.

[ZebreLoup]

Normalement, il devrait garder ces variables en mémoire oui. Je ne sais pas trop ce qui se passe.

Sinon, une autre solution. Déjà pour numLigneDate et nbLignes, tu peux très bien les recalculer dans la deuxième macro, ce n'est pas une problème. La seule chose que tu dois transmettre d'une macro à l'autre c'est le classeur ouvert. Tu peux très bien noter son nom quelque part dans une cellule de ton classeur principal. Et dans la deuxième macro faire (après avoir redéclarer tes variables, plus besoin de les mettre en publiques)

Code :

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

Set wbOuvert = Workbooks(wsActuel.Worksheets("feuilleOuTuAsMisLeNom").Range("A1"))

en remplaçant A1 par la cellule où est le nom.
Tu vois ce que je veux dire ?

Mais normalement, si tu n'as pas cliquer sur le bouton stop dans le VBA Editor ou qu'il n'y a pas eu de plantage autre, ça devrait marcher.

Si vraiment tu galères trop, mets tes fichiers ici et je vais regarder. Ce sera plus facile qu'en essayant de deviner ce qui se passe.

[hortencia]

Eh bien c'est le code que tu m'a envoyé la fois dernière.
Tu sais il était parfait.
C'est lorsque j'ai ajouté les catégories que ça "beuguait" c'est tout.

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
Option Explicit
 
Public numLigneDate As Long
Public nbLignes As Long
Public wbOuvert As Workbook
Public wsOuvert As Worksheet
 
Public procedureEnCours  As Boolean
 
Private Const CHEMIN_FICHIERS As String = "C:\Documents and Settings\llolekal\Bureau"
 
' Choix du fichier et attribution à wbOuvert (variable globale)
Private Function OuvertureFichier(ByRef wb As Workbook) As Boolean
    Dim res As Boolean
    Dim fd As FileDialog
    Dim fichier As String
 
    res = False
 
    Set fd = Application.FileDialog(msoFileDialogOpen)
 
    fd.Filters.Clear
    fd.Filters.Add "Fichier Excel", "*.xls; *.xlsx; *.xlsm"
    fd.AllowMultiSelect = False
    fd.InitialFileName = CHEMIN_FICHIERS
 
    If fd.Show = -1 Then
        fichier = fd.SelectedItems(1)
    End If
 
    On Error Resume Next
    Set wb = Workbooks.Open(fichier)
    If Err.Number = 0 Then res = True Else MsgBox "Erreur à l'ouverture du fichier"
    On Error GoTo 0
 
    OuvertureFichier = res
End Function
 
'Attribution des categories
 
 Private Function GetTypeContenu(ByVal contenu As String) As String
    Select Case contenu
    Case "FRAMBOISE", "MURE", "FRAISE"
        GetTypeContenu = "FRUIT"
    Case "CROISSANT", "VIENNOISE", "CHOUCREME"
        GetTypeContenu = "VIENNOISERIE"
    Case "PORC", "BOEUF", "DINDE", "VOLAILLE", "POULET", "AGNEAU"
        GetTypeContenu = "VIANDE"
    Case Else
        GetTypeContenu = "A CLASSER"
    End Select
End Function
 
 
Public Sub SuiviCashBnpEuro1()
    Dim wbActuel As Workbook
    Dim wsActuel As Worksheet
 
    Dim dateValeur As Date
    Dim c As Range
    Dim i As Integer
    Dim typeObjet As String
 
    'Définition du classeur et de la feuille sur lesquelles je suis
    Set wbActuel = ThisWorkbook
    Set wsActuel = wbActuel.Worksheets(1)
 
    'Ouverture du fichier (classement des elements)
    Dim wbOuvert As Workbook
    If Not OuvertureFichier(wbOuvert) Then Exit Sub
    Set wsOuvert = wbOuvert.Worksheets(1)
 
 
    'Autofit pour mettre en forme le fichier
    wsOuvert.UsedRange.EntireColumn.AutoFit
 
    'On récupère la date de valeur
    dateValeur = wsOuvert.Range("B4").Value
 
    MsgBox dateValeur
 
    'Recherche de la ligne à incrémenter en fonction de la date de valeur
    Set c = wsActuel.Columns("A").Find(dateValeur, LookIn:=xlValues, lookat:=xlWhole)
    If c Is Nothing Then
        MsgBox "Date inexistante"
        Exit Sub
    End If
    numLigneDate = c.Row
 
 
    'Compteur du nombre de ligne à balayer (ie: cellules pleines)
    nbLignes = wsOuvert.Cells(wsOuvert.Cells.Count, 1).End(xlUp).Row
 
For i = 6 To nbLignes 'Pour chaque ligne
 
        'On cherche le contenu
        typeObjet = GetTypeContenu(wsOuvert.Cells(i, 3).Value)
        wsOuvert.Cells(i, 6).Value = typeObjet
 
        'Création liste déroulante
        If typeObjet = "A CLASSER" Then
            With wsOuvert.Cells(i, 6).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="FRUIT,VIENNOISERIE,VIANDE"
                .IgnoreBlank = True
                .InCellDropdown = True
                .ShowInput = True
                .ShowError = True
            End With
        End If
    Next i
 
 
    procedureEnCours = True
 
End Sub
 
 
 
'Deuxième partie de la macro
 
Sub SuiviCashBnpEuro2()
    Dim neg(2) As Double
    Dim pos(2) As Double
    procedureEnCours = True
 
 
'Tri par ordre alphabétique
    wsOuvert.Range("A6:F" & nbLignes).Sort Key1:=wbOuvert.Range("F6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    'Somme par catégories
  For i = 6 To nbLignes
        Select Case wsOuvert.Cells(i, 6).Value
        Case "FRUIT"
            neg(0) = neg(0) + wsOuvert.Cells(i, 4).Value
            pos(0) = pos(0) + wsOuvert.Cells(i, 5).Value
        Case "VIENNOISERIE"
            neg(1) = neg(1) + wsOuvert.Cells(i, 4).Value
            pos(1) = pos(1) + wsOuvert.Cells(i, 5).Value
        Case "VIANDE"
            neg(2) = neg(2) + wsOuvert.Cells(i, 4).Value
            pos(2) = pos(2) + wsOuvert.Cells(i, 5).Value
        End Select
    Next i
 
End Sub

Ca doit être dans la manière dont j'ai procédé.

Dans le module 1, j'ai mis ce code

Dans le module 2, j'ai mis :

Code :

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

1
2
3
4
5
6
7
Private Sub Macro1()
       If (procedureEnCours = True) Then
            SuiviCashBnpEuro2
 
        End If
 
End Sub

Et dans ThisWorkbook :
Private Sub Workbook_Open()
procedureEnCours = False
End Sub

Je rajoute les événements petit à petit pour déboguer plus facilement.

Mais dit moi.
Pour l'instant je n'ai pas fait de bouton(chaque fois que je mets mes macros dans des boutons, elles ne fonctionnent plus donc je voulais d'abord m'assurer qu'elle fonctionne puis créer mes boutons correctement).
J'exécute avec F5 c'est peut être ça le soucis????

Je vais dans le module 1 je fais F5.
Puis sur le module 2 et je fais F5.

Ca ne viens pas de la rassure moi????
Cordialement.

[ZebreLoup]

Non, le fait que tu fasses F5 ne change rien je pense (ou alors je me trompe). Par contre, dès que tu fais une modification dans le code, il perd toutes les variables globales, d'où sans doute le problème. Tu as essayé d'enchainer les deux macros sans aucune modif du code entre temps ?

[hortencia]

Excuse moi d'avoir mis du temps à répondre.

Oui, comme tu me l'a montré au tout début de la discussion.
La première macro ne s'execute plus jusqu'au bout.
J'ai mis des messagebox pour voir là ou elle s'arrête.
Elle s'arrête juste avant ça mais je ne vois pas pourquoi.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
' 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

Merci.
Cordialement.

[ZebreLoup]

Si tu utilises F8 au lieu de F5, tu exécutes ton code en mode pas à pas. Ca va te permettre de regarder ce qui se passe exactement. Pense aussi à utiliser les "espions" pour connaitre les valeurs de tes variables. Et plutôt que des messageBox, tu peux utiliser

Code :

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

Debug.Print "ton message"

Tu peux suivre le résultat dans la fenêtre exécution du VBA Editor. C'est moins contraignant.

[hortencia]

C'est sur, il va directement au message d'erreur.

J'ai encadré le bout de code par deux MesssageBox.
Il m'affiche celui avant cette instruction mais pas celui qui je place après.

Cordialement.

Avec F8, j'ai la confirmation de ce que je disais.
Ceci ne fonctionne pas.
Et la macro va directement au message d'erreur.

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

Pourtant le même code fonctionne bien normalement.
Cordialement.

J'ai retirer le "exit sub" le message d'erreurs et le On erreur go to pour voir où se trouvait l'erreur.

Le beug se trouve ici :

Code :

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

With Sheets("Feuil1")

L'INDICE N4APPARTIENT PAS A LA SELECTION.

Cordialement.

As t-on le droit de mettre ceci :

Code :

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

With Sheets("Feuil1")

Sachant que j'ai mis Option Explicit.

Cordialemant.

[ZebreLoup]

Tu as bien une feuille qui s'appelle "Feuil1" dans ton classeur actif ? A priori le Wbk1 vu la ligne précédente.

(D'où l'intérêt de préciser sur quel classeur on travaille plutôt que de compter sur le fait que celui actif est bien le bon)

[hortencia]

Oui.
Je ne comprends pas le "beug", sachant que sans rien ça marche.

Cordialement.

[ZebreLoup]

J'avoue que ça devient compliqué à deviner pour moi. Si les fichiers ne sont pas trop lourd et ne contiennent rien de confidentiel, tu peux les mettre en pièces jointes ?

[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 Zebreloup,

Je n'ai pas encore adapté à mon code mais le tien compile à la perfection.
Et en plus j'ai compris.

Code :

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

Set fd = Application.FileDialog(msoFileDialogOpen)

Ceci renvoyé en fait un String (Non du classeur).
C'est la raison pour laquelle cela ne compilait pas avant.
C'est fou !!!!! T'es génial.
Merci infiniment pour toute ton aide et toute ton implication dans les problèmes de mon programme.
C'est plus que parfait.
MERCI MERCI MERCI !!!!!.

Très Cordialement.

Oups!!!!

J'ai un petit soucis.
Je sais pourquoi mais je ne sais pas comment en changer de manière efficiente.

Je remarque que contrairement à mon ancien code, les jours et les mois de ma date sont inversés.

C'est parce qu'on est en option explicit?

le 12/05/2011 devient le 05/12/2011.

Cordialement.