Discussion :

[micoscas]

Bonjour,

J'utilise la portion de code suivante :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
 
Workbooks("SUP_G_" & nom & ".xls").Activate 
 
'Activation de la feuille ou création de celle-ci si elle n'existe pas 
 
On Error Resume Next 
Worksheets(code_be).Activate 
 
If Err.Number <> 0 Then 
    Application.DisplayAlerts = False 
 
 
    Sheets("Sheet1").Activate 
    ActiveSheet.Copy before:=Worksheets("Sheet1") 
    ActiveSheet.Name = code_be 
 
    Err.Clear 
 
End If 
On Error GoTo 0

La plus part du tps cette partie fonctionne bien mais des fois elle bogue et m'envoie un message d'erreur :"Indice en dehors de la plage".
Je ne comprends pas pq puisque j'ai mis un "on error resume next", il devrait donc continuer....

Si qqn sait....
Merci.

[HPJ]

Quelle est la ligne de l'erreur :

[micoscas]

Si tu veux parler de la ligne

Code :

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

1
2
3
 
On Error Resume Next 
Worksheets(code_be).Activate

il s'agit de la ligne 4614.

[mat.M]

Faudrait peut-être mettre un exit sub ou function

Code :

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

1
2
3
4
5
6
 
On Error Goto message_erreur
action_1
Exit Sub
message_erreur:
MsgBox Err.Description

[HPJ]

Tu es sûr que c'est la ligne Worksheets(code_be).Activate qui génère l'erreur lorsque ta fonction bogue :

[micoscas]

oui j'en suis sur que c celle la qui bogue car mon programme passe plusieurs fois par cette instruction grace a des boucles et execute la ligne (et donc ce qui suit puisque normalement c logique qu'ube erreur soit generee a ce niveau) ceci sans aucun pb!!!!

[micoscas]

Bonjour,

g un pb qui dure maintenant depui plus d'une semaine et g tjs pas de reponse alor je relance ma question au cas ou car c vraiment important!

Voila, en fait g un pb avec la partie de code suivante:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
 
Workbooks("SUP_G_" & nom & ".xls").Activate 
 
'Activation de la feuille ou création de celle-ci si elle n'existe pas 
 
On Error Resume Next 
Worksheets(code_be).Activate 
 
If Err.Number <> 0 Then 
 
    Application.DisplayAlerts = False 
    Sheets("Sheet1").Activate 
    ActiveSheet.Copy before:=Worksheets("Sheet1") 
    ActiveSheet.Name = code_be 
 
    Err.Clear 
 
End If 
On Error GoTo 0

Le pb est lors de la creation des feuilles. Normalement lorsqu'une feuille n'existe pas une erreur se declenche mai ma procedure doit continuer grace a la fct on error resume next. Et bien ce qui est etonnant c que cette instruction est dans une boucle et qu'elle marche pour les premieres boucles et apres elle bogue au niveau de la ligne:

Code :

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

1
2
3
 
On Error Resume Next 
Worksheets(code_be).Activate

le message d'erreur 9 s'affiche ce qui n'est pas normal je pense!
voila c tout!!!
Merci.

[HPJ]

Si tu mets la ligne suivante en commentaire, tu n'as plus d'erreur :

Code :

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

' Worksheets(code_be).Activate

[micoscas]

oui ca marche sans cette ligne mais ca fait pas exactement ce que je veu.

De plus la ligne suivante ne marche plus:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
On Error Resume Next
plageARemplir1.PasteSpecial Paste:=xlPasteValues
 
If Err.Number <> 0 Then
 
    ActiveSheet.plageARemplir1.Value = 0
 
End If
 
Err.Clear
On Error GoTo 0

C trop bizarre c comme si tous les "on error resume next" ne marchaient plus!!

[HPJ]

Tu peux nous donner le code complet de ta procédure :

[micoscas]

desole pour ce que mon code va les heurter mais je suis debutant et c pa tres propre. Bon le voila:

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
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
 
Private Sub MAJ_SUP_Click()
 
Dim entite, dept, fil, bass As String
Dim nom, annee, mois, annee_depart, doublon, date_ref, statut_g As String
Dim fichiers, nom_projet, nouv_class As String
Dim ref_piste, ref_piste_suiv As String
Dim code_be, version, etat, cpm, annee_g As Variant
Dim i, j, annee_dep As Integer
Dim cnx As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim plageSource1, plageSource2, plageSource3, plageSource4 As Range
Dim plageSource20, plageSource21, plageSource22, plageSource23, plageSource24, plageSource25, plageSource26, plageSource27, plageSource28, plageSource29 As Range
Dim plageSource40, plageSource41, plageSource42, plageSource43, plageSource44, plageSource45, plageSource46, plageSource47, plageSource48, plageSource49 As Range
Dim plageARemplir1, plageARemplir2, plageARemplir3, plageARemplir4 As Range
Dim plageARemplir20, plageARemplir21, plageARemplir22, plageARemplir23, plageARemplir24, plageARemplir25, plageARemplir26, plageARemplir27, plageARemplir28, plageARemplir29 As Range
Dim plageARemplir40, plageARemplir41, plageARemplir42, plageARemplir43, plageARemplir44, plageARemplir45, plageARemplir46, plageARemplir47, plageARemplir48, plageARemplir49 As Range
 
annee = ActiveWorkbook.Sheets("MAJ_G").BoxAnnee.Text
mois = ActiveWorkbook.Sheets("MAJ_G").BoxMois.Text
nom = annee & mois
 
 
ChDrive "h"
 
Select Case mois
 
    Case Is = "01"
        mois = "Janvier"
 
    Case Is = "02"
        mois = "Fevrier"
 
    Case Is = "03"
        mois = "Mars"
 
     Case Is = "04"
        mois = "Avril"
 
    Case Is = "05"
        mois = "Mai"
 
    Case Is = "06"
        mois = "Juin"
 
    Case Is = "07"
        mois = "Juillet"
 
    Case Is = "08"
        mois = "Aout"
 
    Case Is = "09"
        mois = "Septembre"
 
    Case Is = "10"
        mois = "Octobre"
 
    Case Is = "11"
        mois = "Novembre"
 
    Case Is = "12"
        mois = "Decembre"
 
    End Select
 
ChDir "H:\09- CPM Supports\091- Complet_Init_Réestimé\0911- En cours"
 
fichiers = Dir("*.*", 16)
 
While fichiers = "." Or fichiers = ".."
 
    fichiers = Dir
 
Wend
 
'Ouverture de la base de données
cnx.Open ("Driver={Microsoft Access Driver (*.mdb)};Dbq=F:\Commun\Norma 2004\Bases communes\Reportings Norma.mdb")
 
'Ouverture de la connexion
Set cmd.ActiveConnection = cnx
 
'Préparation de l'objet Command
cmd.CommandText = "SELECT [Référentiel budgétaire GIP ExD].[Ldir grol], [Référentiel budgétaire GIP ExD].[LDpt Grol], [Base gains].Filière, [*tab_corresp_bassin].[code2 bassin], [Base gains].Année, [Base gains].Trimestre, [Base gains].[Ref Piste], [Base gains].Piste, [Base gains].[Gains ou besoins], [Base gains].Type, [Base gains].[Date début d'effet], [Base gains].[Date fin d'effet], [Base gains].Statut, [Base gains].Validation, [Base gains].Budget FROM [*tab_corresp_bassin] RIGHT JOIN ([Base gains] LEFT JOIN [Référentiel budgétaire GIP ExD] ON ([Base gains].Entité = [Référentiel budgétaire GIP ExD].LDIRECT) AND ([Base gains].Département = [Référentiel budgétaire GIP ExD].LDEP)) ON [*tab_corresp_bassin].[code bassin] = [Base gains].[Bassin d'emploi] WHERE ((([Base gains].statut) = 'reali') And ((Left([Ref Piste], 4)) = 'sup_')) ORDER BY [Base gains].[Ref Piste];"
 
'Exécution de la requête
Set rst = cmd.Execute
 
'Application.AskToUpdateLinks = True
 
'boucle parcours des fichiers projets
While fichiers <> ""
 
Workbooks.Open FileName:="H:\20- Traitements & Archives\Gains\" & mois & " " & Right(annee, Len(annee) - 2) & "\SUP_G_" & nom & ".xls", updatelinks:=0
 
Do 'boucle faire changement de projet
 
On Error Resume Next
Workbooks.Open (fichiers)
 
If Err.Number <> 0 Then
 
    Exit Sub
 
End If
 
Err.Clear
 
On Error GoTo 0
 
Sheets("Gains ETP hors AXAWay").Activate
 
Set plageSource1 = Workbooks(fichiers).ActiveSheet.Range("c9:f10")
 
'Set plageSource2 = Workbooks(fichiers).ActiveSheet.Range("h9:p10")
 
Set plageSource20 = Workbooks(fichiers).ActiveSheet.Range("h9")
Set plageSource21 = Workbooks(fichiers).ActiveSheet.Range("j9")
Set plageSource22 = Workbooks(fichiers).ActiveSheet.Range("l9")
Set plageSource23 = Workbooks(fichiers).ActiveSheet.Range("n9")
Set plageSource24 = Workbooks(fichiers).ActiveSheet.Range("p9")
Set plageSource25 = Workbooks(fichiers).ActiveSheet.Range("h10")
Set plageSource26 = Workbooks(fichiers).ActiveSheet.Range("j10")
Set plageSource27 = Workbooks(fichiers).ActiveSheet.Range("l10")
Set plageSource28 = Workbooks(fichiers).ActiveSheet.Range("n10")
Set plageSource29 = Workbooks(fichiers).ActiveSheet.Range("p10")
 
Set plageSource3 = Workbooks(fichiers).ActiveSheet.Range("c22:f23")
 
'Set plageSource4 = Workbooks(fichiers).ActiveSheet.Range("h22:p23")
 
Set plageSource40 = Workbooks(fichiers).ActiveSheet.Range("h22")
Set plageSource41 = Workbooks(fichiers).ActiveSheet.Range("j22")
Set plageSource42 = Workbooks(fichiers).ActiveSheet.Range("l22")
Set plageSource43 = Workbooks(fichiers).ActiveSheet.Range("n22")
Set plageSource44 = Workbooks(fichiers).ActiveSheet.Range("p22")
Set plageSource45 = Workbooks(fichiers).ActiveSheet.Range("h23")
Set plageSource46 = Workbooks(fichiers).ActiveSheet.Range("j23")
Set plageSource47 = Workbooks(fichiers).ActiveSheet.Range("l23")
Set plageSource48 = Workbooks(fichiers).ActiveSheet.Range("n23")
Set plageSource49 = Workbooks(fichiers).ActiveSheet.Range("p23")
 
ActiveSheet.Unprotect ("christian")
 
'Copie des valeurs des tableaux des gains ETP Hors AXAWay
plageSource1.Select
Selection.Copy
 
'plageSource2.Select
'Selection.Copy
 
 
 
plageSource20 = ActiveSheet.Cells(9, 8).Value
plageSource21 = ActiveSheet.Cells(9, 10).Value
plageSource22 = ActiveSheet.Cells(9, 12).Value
plageSource23 = ActiveSheet.Cells(9, 14).Value
plageSource24 = ActiveSheet.Cells(9, 16).Value
plageSource25 = ActiveSheet.Cells(10, 8).Value
plageSource26 = ActiveSheet.Cells(10, 10).Value
plageSource27 = ActiveSheet.Cells(10, 12).Value
plageSource28 = ActiveSheet.Cells(10, 14).Value
plageSource29 = ActiveSheet.Cells(10, 16).Value
 
'plageSource3.Copy
 
plageSource40 = ActiveSheet.Cells(22, 8).Value
plageSource41 = ActiveSheet.Cells(22, 10).Value
plageSource42 = ActiveSheet.Cells(22, 12).Value
plageSource43 = ActiveSheet.Cells(22, 14).Value
plageSource44 = ActiveSheet.Cells(22, 16).Value
plageSource45 = ActiveSheet.Cells(23, 8).Value
plageSource46 = ActiveSheet.Cells(23, 10).Value
plageSource47 = ActiveSheet.Cells(23, 12).Value
plageSource48 = ActiveSheet.Cells(23, 14).Value
plageSource49 = ActiveSheet.Cells(23, 16).Value
 
nom_projet = ActiveSheet.Cells(1, 1).Value
code_be = ActiveSheet.Cells(2, 14).Value
annee_depart = ActiveSheet.Cells(8, 8).Value
cpm = ActiveSheet.Cells(2, 3).Value
etat = ActiveSheet.Cells(3, 3).Value
version = ActiveSheet.Cells(3, 14).Value
date_ref = ActiveSheet.Cells(18, 6).Value
statut_g = ActiveSheet.Cells(18, 10).Value
 
 
 
Workbooks("SUP_G_" & nom & ".xls").Activate
 
'Activation de la feuille ou création de celle-ci si elle n'existe pas
 
On Error Resume Next
Worksheets(code_be).Activate
 
If Err.Number <> 0 Then
 
    Application.DisplayAlerts = False
    Sheets("Sheet1").Activate
    ActiveSheet.Copy before:=Worksheets("Sheet1")
    ActiveSheet.Name = code_be
 
    Err.Clear
 
End If
On Error GoTo 0
 
ActiveSheet.Cells(1, 1).Value = nom_projet
ActiveSheet.Cells(2, 14).Value = code_be
ActiveSheet.Cells(20, 8).Value = annee_depart
ActiveSheet.Cells(20, 10).Value = annee_depart + 1
ActiveSheet.Cells(20, 12).Value = annee_depart + 2
ActiveSheet.Cells(20, 14).Value = annee_depart + 3
ActiveSheet.Cells(20, 16).Value = annee_depart + 4
ActiveSheet.Cells(2, 3).Value = cpm
ActiveSheet.Cells(3, 3).Value = etat
ActiveSheet.Cells(3, 14).Value = version
ActiveSheet.Cells(17, 6).Value = date_ref
ActiveSheet.Cells(17, 10).Value = statut_g
ActiveSheet.Cells(6, 5).Value = annee
 
Set plageARemplir1 = Workbooks("SUP_G_" & nom & ".xls").ActiveSheet.Range("c9:f10")
'Set plageARemplir3 = Workbooks("sup_G_" & nom & ".xls").ActiveSheet.Range("c22:f23")
 
On Error Resume Next
plageARemplir1.PasteSpecial Paste:=xlPasteValues
 
If Err.Number <> 0 Then
 
    ActiveSheet.plageARemplir1.Value = 0
 
End If
 
Err.Clear
On Error GoTo 0
Workbooks(fichiers).Worksheets("Gains ETP hors AXAWay").Activate
ActiveSheet.Range("h8:p8").Select
Selection.Copy
 
Workbooks("SUP_G_" & nom & ".xls").Worksheets(code_be).Activate
ActiveSheet.Cells(9, 8).Value = plageSource20
ActiveSheet.Cells(9, 10).Value = plageSource21
ActiveSheet.Cells(9, 12).Value = plageSource22
ActiveSheet.Cells(9, 14).Value = plageSource23
ActiveSheet.Cells(9, 16).Value = plageSource24
ActiveSheet.Cells(10, 8).Value = plageSource25
ActiveSheet.Cells(10, 10).Value = plageSource26
ActiveSheet.Cells(10, 12).Value = plageSource27
ActiveSheet.Cells(10, 14).Value = plageSource28
ActiveSheet.Cells(10, 16).Value = plageSource29
 
ActiveSheet.Cells(21, 8).Value = plageSource40
ActiveSheet.Cells(21, 10).Value = plageSource41
ActiveSheet.Cells(21, 12).Value = plageSource42
ActiveSheet.Cells(21, 14).Value = plageSource43
ActiveSheet.Cells(21, 16).Value = plageSource44
ActiveSheet.Cells(22, 8).Value = plageSource45
ActiveSheet.Cells(22, 10).Value = plageSource46
ActiveSheet.Cells(22, 12).Value = plageSource47
ActiveSheet.Cells(22, 14).Value = plageSource48
ActiveSheet.Cells(22, 16).Value = plageSource49
 
ActiveSheet.Range("h8:p8").Select
Selection.PasteSpecial Paste:=xlValues
 
 
 
i = 33
j = 100
 
Workbooks(fichiers).Worksheets("Gains ETP hors AXAWay").Activate
 
Do While ActiveSheet.Cells(j, 2) <> " "
 
    entite = ActiveSheet.Cells(j, 2).Value
    dept = ActiveSheet.Cells(j, 3).Value
    fil = ActiveSheet.Cells(j, 5).Value
    bass = ActiveSheet.Cells(j, 7).Value
 
    j = j + 3
 
    Workbooks("SUP_G_" & nom & ".xls").Worksheets(code_be).Activate
 
    ActiveSheet.Cells(i, 2).Value = entite
    ActiveSheet.Cells(i, 3).Value = dept
    ActiveSheet.Cells(i, 5).Value = fil
    ActiveSheet.Cells(i, 7).Value = bass
 
    i = i + 3
 
    Workbooks(fichiers).Worksheets("Gains ETP hors AXAWay").Activate
 
Loop
 
Workbooks("SUP_G_" & nom & ".xls").Worksheets(code_be).Activate
 
doublon = "non"
i = 33
 
line1622:
If rst.BOF = True Then 'Test si la base contient des enregistrements
 
    GoTo line1833
 
Else
 
Do Until rst.EOF = True Or code_be <> rst.Fields("Ref Piste") Or Nz(rst.Fields("Date fin d'effet"), "") = "28/02/05" 'boucle si projet a des gains réalisés
 
 
     While ActiveSheet.Cells(i, 2).Value <> " "  'boucle si la maille apparait deja dans la table des gains realisés
 
        'si c'est un doublon
        If rst.Fields("Ldir grol") = ActiveSheet.Cells(i, 2).Value And rst.Fields("LDpt Grol") = ActiveSheet.Cells(i, 3).Value And rst.Fields("Filière") = ActiveSheet.Cells(i, 5).Value And rst.Fields("code2 bassin") = ActiveSheet.Cells(i, 7).Value Then 'And rst.Fields("Date fin d'effet") <> "28/02/05" Then
 
            doublon = "oui"
            annee_g = rst.Fields("Année")
 
            Select Case annee_g
 
                Case Is = ActiveSheet.Cells(31, 15).Value
                    ActiveSheet.Cells(i, 15).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = ActiveSheet.Cells(31, 16).Value
                    ActiveSheet.Cells(i, 16).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = ActiveSheet.Cells(31, 17).Value
                    ActiveSheet.Cells(i, 17).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = ActiveSheet.Cells(31, 18).Value
                    ActiveSheet.Cells(i, 18).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = ActiveSheet.Cells(31, 19).Value
                    ActiveSheet.Cells(i, 19).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
            End Select
 
            rst.MoveNext
            i = 33
 
 
            If rst.EOF = True Then
 
                Exit Do
 
            End If
 
            GoTo line1622
 
        'si ce n'est pas un doublon
        Else
 
            i = i + 3
 
        End If
 
  Wend 'Fin de boucle si la maille apparait deja dans gains realisés
 
    If doublon = "non" Then
 
        ActiveSheet.Cells(i, 2).Value = rst.Fields("Ldir grol")
        ActiveSheet.Cells(i, 3).Value = rst.Fields("LDpt Grol")
        ActiveSheet.Cells(i, 5).Value = rst.Fields("Filière")
        ActiveSheet.Cells(i, 7).Value = rst.Fields("code2 bassin")
 
        If rst.Fields("Trimestre") <> "ND" Then
 
            Select Case rst.Fields("Trimestre")
 
                Case Is = "T1"
                    ActiveSheet.Cells(i, 11).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = "T2"
                    ActiveSheet.Cells(i, 12).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = "T3"
                    ActiveSheet.Cells(i, 13).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
                Case Is = "T4"
                    ActiveSheet.Cells(i, 14).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
            End Select
 
        End If
 
        annee_g = rst.Fields("Année")
 
        Select Case annee_g
 
            Case Is = ActiveSheet.Cells(31, 15).Value
                ActiveSheet.Cells(i, 15).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
            Case Is = ActiveSheet.Cells(31, 16).Value
                ActiveSheet.Cells(i, 16).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
            Case Is = ActiveSheet.Cells(31, 17).Value
                ActiveSheet.Cells(i, 17).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
            Case Is = ActiveSheet.Cells(31, 18).Value
                ActiveSheet.Cells(i, 18).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
            Case Is = ActiveSheet.Cells(31, 19).Value
                ActiveSheet.Cells(i, 19).Value = Right(rst.Fields("Gains ou besoins"), Len(rst.Fields("Gains ou besoins")) - 1)
 
        End Select
 
    End If 'Fin test si doublon="non"
 
     rst.MoveNext
 
    If rst.EOF = True Then
 
        Exit Do
 
    End If
 
Loop  'fin boucle si projet a des gains réalisés
 
End If 'Test si base contient des enregistrements
 
On Error GoTo line1833
If Not rst.EOF And code_be = rst.Fields("Ref Piste") Then
 
    rst.MoveNext 'Si on sort de la boucle car on a une annee de fin d'effet comme on ne passe a
                    'l'enregistrement suivant dans la boucle on le fait ici
 
End If
 
line1833:
Workbooks(fichiers).Close savechanges:=False
Application.DisplayAlerts = True
fichiers = Dir
 
Loop While fichiers <> "" 'fin boucle faire changement de projet
 
Wend
 
 
line1662:
Workbooks("SUP_G_" & nom & ".xls").Close savechanges:=True
 
End Sub

Merci encore!

[HPJ]

Ouahh, tu devrais structurer ce gros code en plusieurs procédures et fonctions...
Tu peux essayer de faire le Err.Clear juste après le test If Err.Number <> 0
Mais je pense qu'il faut que tu structures ton code parceque ça devient ingérable: impossible de déterminer la dernière instruction On error active...
T'as débogué en pas à pas après la première erreur gérée et avant celle qui plante :

[micoscas]

oui g execute pas a pas mais je vois pas ou est le pb!
Pq ca marcherait ls 6 premieres boucles et pas la 7è?
D'autant plus que ca c pour un fichier excel mais pour 'autres toutes les boucles fonctionent!!

[HPJ]

Je peux pas te dire, il faudrait plusieurs heures pour analyser un tel code avec des Goto, boucles dans tous les sens...
A toi de faire du ménage...
De plus il faut être rigoureux dans la gestion des erreurs surtout dans les boucles, j'ai déjà vu des problèmes si tu ne fais pas de Err.Clear ou des Resume maLigne suite à une erreur...

[micoscas]

ok merci j vais voir mais en tout cas c sur que c pas un pb de err clear ou resume next car g verifie y en a a chaque fois que g utilise on error!
Est ce que c 'est pôssible que ce soit une histoire de gestionnaire actif ou je sais pas quoi?
car g regarder l'aide et voila ce qu'elle dit :

Code :

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

1
2
 
Un gestionnaire d'erreurs est "validé" lorsqu'il a été désigné par une instruction On Error ; le gestionnaire d'erreurs "actif" est un gestionnaire validé qui traite une erreur. Si une erreur se produit alors qu'un gestionnaire d'erreurs est actif (c'est-à-dire entre la ligne où survient une erreur et une instruction Resume, Exit Sub, Exit Function ou Exit Property), le gestionnaire d'erreurs de la procédure en cours ne peut gérer l'erreur. Le contrôle revient à la procédure appelante. Si la procédure appelante possède un gestionnaire d'erreurs validé, il est activé afin de gérer l'erreur.

Enfin moi j'en ai marre qd je pense que pour certain fichier ca marche nickel alor que le code est exactement le m ( g fais un copier coller)c juste les lignes de code ou y a le nom du fichier qui changent!!

Bon bonne journee a tous et encore merci.

[HPJ]

ok merci j vais voir mais en tout cas c sur que c pas un pb de err clear ou resume next car g verifie y en a a chaque fois que g utilise on error!

je pense que tu as mal vérifié:

Code :

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

1
2
3
4
5
6
7
On Error GoTo line1833
' ...
' ...
line1833:
   Workbooks(fichiers).Close savechanges:=False 
   Application.DisplayAlerts = True 
   fichiers = Dir

Dans ce cas tu ne dis pas où reprendre l'exécution -> tu restes dans un contexte d'erreur et les instructions On Error qui seront exécutées par la suite seront inefficaces

Un simple exemple qui va te faire comprendre:

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
Private Sub Form_Load()
 
    Dim i As Long
 
    For i = 1 To 3
 
        On Error GoTo DansTousLesCas ' instruction (1)
 
        MsgBox 3 / 0 ' -> Erreur
 
DansTousLesCas:
        MsgBox "ExécutéDansTousLesCas"
 
        ' l'instruction suivante parait inutile 
        ' mais si elle n'y est pas l'instruction (1) sera inefficace
        ' à l'itération suivante 
        ' car le code ne sort pas du contexte d'erreur
        ' et un même un Err.Clear ne suffirait pas
        Resume Suite ' sort du contexte d'erreur et fait implicitement un Err.Clear 
Suite:
 
    Next i
 
End Sub

[micoscas]

Je ne sui pas sur d'avoir compris ce que tu m as dis car apres cette partie de code g un loop qui lui dis ou reprendre:

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
 
On Error GoTo line1833
If Not rst.EOF And code_be = rst.Fields("Ref Piste") Then
 
    rst.MoveNext 'Si on sort de la boucle car on a une annee de fin d'effet comme on ne passe a
                    'l'enregistrement suivant dans la boucle on le fait ici
 
End If
 
line1833:
Workbooks(fichiers).Close savechanges:=False
Application.DisplayAlerts = True
fichiers = Dir
number = Err.number
descrip = Err.Description
Err.Clear
'On Error GoTo 0
 
Loop While fichiers <> "" 'fin boucle faire changement de projet

ca le ramene au debut pour ouvrir un nouveau fichier source dont il va prendre les valeur et les copier dans un nouvel onglet de mon fichier destination (enfin j'aimerai qu il me creer un nouvel onglet mais c la qu il bogue!!!).

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Do 'boucle faire changement de projet
 
On Error Resume Next
Workbooks.Open (fichiers)
 
If Err.number <> 0 Then
 
    Exit Sub
 
End If
 
Err.Clear

[HPJ]

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
 
On Error GoTo line1833 ' En cas d'erreur -> line1833 OK
If Not rst.EOF And code_be = rst.Fields("Ref Piste") Then
 
    rst.MoveNext 'Si on sort de la boucle car on a une annee de fin d'effet comme on ne passe a
                    'l'enregistrement suivant dans la boucle on le fait ici
 
End If
 
line1833: ' supposons qu'on arrive ici suite à une erreur
Workbooks(fichiers).Close savechanges:=False
Application.DisplayAlerts = True
fichiers = Dir
number = Err.number
descrip = Err.Description
Err.Clear ' l'erreur est effacée mais on est toujours dans un contexte de traitement d'erreur
'On Error GoTo 0
 
Loop While fichiers <> "" 'fin boucle faire changement de projet

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Do 'boucle faire changement de projet
 
On Error Resume Next ' COMME ON N'EST PAS SORTI DU TRAITEMENT DE L'ERREUR CETTE INSTRUCTION NE FAIT RIEN ET LA PROCHAINE ERREUR FERA PLANTER LE PROGRAMME !!!!!!!!!!!!!!!!!
Workbooks.Open (fichiers)
 
If Err.number <> 0 Then
 
    Exit Sub
 
End If
 
Err.Clear

Et pour sortir d'un contexte d'erreur seule l'instruction Resume maLigne (fin de la gestion des erreurs) permet de dire que le traitement de l'erreur est terminée et où continuer l'exécution, à ne pas confondre avec On Error Resume maLigne (début de la gestion des erreurs) qui indique où aller suite à une erreur.

[micoscas]

c bon ca marche!!

Je te remercie vraiment d'avoir pris ton tps pour resoudre mon pb, je commencais a desesperer!!

Par contre g un autre petit pb:

Lorsque j'execute ma macro elle remplie des cellules et moi sous excel g affecte a certaines cellule la fct somme. Or lors du remplissage des cellules par ma macro les cellules contenant la fct somme devraient se remplir aussi. Pourtant certaines (mais pas toutes ) ne se remplissent pas, je ne vois pas pq alor que qd je clique sur la cellule il est bien ecrit "somme(X:X)".

Merci encore.

[HPJ]

Merci de marquer ce sujet résolu et d'en créer un nouveau pour ton autre problème.