Lancer macro 1 seul fois sur activation feuille

**zeralium** · 08/09/2008, 22h56

Bonjour,

Comment faire pour qu'une macro se lance (1 seul fois) lorsque la feuille devient active. Actuellement j'utilise:

Code :

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

Private Sub Worksheet_Activate()

puis ma macro. Mais ma macro tourne tout le temps.

**JackOuYA** · 08/09/2008, 23h00

Bonsoir,

Qu'appelle-tu tourne tous le temps ..? le code dans WorkSheet_activate et exécuter à chaque activation de la feuille.

un code qui n'est exécutez qu'une seule fois à l'ouverture de ton classeur :

Code :

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

1
2
3
Private Sub Workbook_Open()
 
End Sub

**fring** · 08/09/2008, 23h30

Bonjour tlm,

Si la procédure "tourne tout le temps"...n'aurais-tu pas un code parsemé de "Select" qui ressemble à ceci :

Code :

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

1
2
3
4
5
6
7
8
9
'dans le module de la feuille "Feuil1"
Private Sub Worksheet_Activate()
    Sheets("Feuil2").Select
    'ton code
    '....
    '....
    '....
    Sheets("Feuil1").Select
End Sub

**zeralium** · 08/09/2008, 23h31

Si tout a fait, j'ai pas mal de selection de feuille dans ma macro.

**fring** · 08/09/2008, 23h36

Envoyé par zeralium

Si tout a fait, j'ai pas mal de selection de feuille dans ma macro.

c'est là qu'est l'os, à la fin de ton code tu réactives la feuille et hop...comme quand tu attrapes la "floche" sur le carrousel...tu es reparti pour un tour gratuit.

Les "Select" sont dans la majorité des cas inutiles.
Montre ton code, on va essayer d'arranger ça

**zeralium** · 08/09/2008, 23h56

Mon code dans le fichier joint.

Code :

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

1
2
3
Private Sub Worksheet_Activate()
    Application.Run "PERSO.XLS!PROGRESS"
End Sub

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
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
Sub PROGRESS()
Dim a As Integer 'a = numero de colonne, correspond à la colonne total
Dim b As Integer 'b = numero de colonne, correspond aux colonnes contenant un automate
Dim c As Integer 'c = nombre tampon,
Dim d As String 'd correspond à une feuille, tampon
Dim lignesemaine As Integer 'e = numero de ligne, correspond aux semaines
Dim NumSem As Byte 'NumSem correspond au numero de la semaine en cours en réel
Dim couleur As Integer 'couleur
Dim colonne As Integer 'colonne
Dim ligne As Integer 'ligne
'Dim f As Integer 'f = tampon pour remplissage feuille progress, automate
'Dim g As Integer 'g= tampon pour colonne automate feuille progress
 
Application.ScreenUpdating = True
 
'§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
'§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§ - CALCUL - §§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
'§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
 
'***** DEBUT - PROGRESS - Mise à jour noms des automates avec PARAMETRES
Sheets("parametres").Select
ligne = 2
colonne = 2
While Not Cells(ligne, 1) = ""
    If Cells(ligne, 1) > 0 Then
        Cells(ligne, 1).Select
        Selection.Copy
        Sheets("progress").Select
 
        While Cells(1, colonne) = ""
        If Cells(1, colonne) = 0 Then
            Cells(1, colonne).Select
            ActiveSheet.Paste
            End If
 
        Wend
        colonne = colonne + 1
    End If
ligne = ligne + 1
Sheets("parametres").Select
Wend
Sheets("progress").Select
Cells(1, colonne) = "Total"
'***** FIN - PROGRESS - Mise à jour noms des automates avec PARAMETRES
 
'***** DEBUT - PROGRESS - Mise à jour des numero de semaine dans les onglets "parametres" et "progress"
lignesemaine = 8
'Recherche dans onglet progress la derniere semaine enregistré
Sheets("progress").Select
While Not Cells(lignesemaine, 1) = ""
        lignesemaine = lignesemaine + 1
Wend
lignesemaine = lignesemaine - 1
 
'Dans onglet parametres affiche le n° de semaine apres premier import dans semaine debut, semaine en cours et dans progress semaine en cours
Sheets("parametres").Select
If Range("L1") = "" Then
NumSem = DatePart("ww", Date, 2, 2)
Range("L1").Value = "S" & " " & NumSem
Range("L2").Value = "S" & " " & NumSem
Sheets("progress").Select
Cells(lignesemaine, 1).Value = "S" & " " & NumSem
Else
    'Dans onglet parametres, affiche le n° semaine en cours si il est different du n° de début
    Sheets("parametres").Select
    NumSem = DatePart("ww", Date, 2, 2)
    Range("L2").Value = "S" & " " & NumSem
        'Dans onglet progress, incremente le n° des semaines si different de la semaine precedente
        If Range("L2") <> Sheets("Progress").Cells(lignesemaine, 1) Then
        Sheets("progress").Select
        lignesemaine = lignesemaine + 1
        NumSem = DatePart("ww", Date, 2, 2)
        Cells(lignesemaine, 1).Value = "S" & " " & NumSem
        Sheets("parametres").Select
        End If
End If
'***** FIN - Mise à jour des numero de semaine dans les onglets "parametres" et "progress"
 
'***** DEBUT - Calcul du nombre total IO par automate
Sheets("progress").Select
b = 2
    While Not Cells(1, b) = ""
        While Not Cells(1, b) = "Total"
        If Cells(1, b) > 0 Then
        d = Cells(1, b)
        Sheets(d).Select
        Cells(1, 16).Activate
        ActiveCell.FormulaR1C1 = "=COUNTIF(C1,""*"")-1"
        c = Cells(1, 16)
        Selection.ClearContents
        Sheets("progress").Select
        Cells(2, b) = c
        End If
        b = b + 1
        Sheets("progress").Select
        Wend
        b = b + 1
    Wend
'%%%%% FIN - Calcul du nombre total IO par automate
 
'***** DEBUT - Calcul du nombre total IO testé par automate
Sheets("progress").Select
b = 2
While Not Cells(1, b) = ""
    While Not Cells(1, b) = "Total"
    If Cells(1, b) > 0 Then
    d = Cells(1, b)
    Sheets(d).Select
    Cells(1, 16).Activate
    ActiveCell.FormulaR1C1 = "=COUNTIF(C12,""*"")-1"
    c = Cells(1, 16)
    Selection.ClearContents
    Sheets("progress").Select
    Cells(3, b) = c
    End If
    b = b + 1
    Sheets("progress").Select
    Wend
    b = b + 1
Wend
'%%%%% FIN - Calcul du nombre total IO testé par automate
 
'***** DEBUT - Difference nombre IO testé et non testé
b = 2
While Not Cells(1, b) = ""
    While Not Cells(1, b) = "Total"
    If Cells(1, b) > 0 Then
    Cells(4, b) = Cells(2, b) - Cells(3, b)
    End If
    b = b + 1
    Wend
    b = b + 1
Wend
'***** FIN - Difference nombre IO testé et non testé
 
'***** DEBUT - Calcul le progres par automate
b = 2
While Not Cells(1, b) = ""
    While Not Cells(1, b) = "Total"
    If Cells(1, b) > 0 Then
    Cells(5, b) = Cells(3, b) / Cells(2, b)
    Cells(5, b).Select
    Selection.NumberFormat = "0.00%"
    End If
    b = b + 1
    Wend
    b = b + 1
Wend
'***** FIN - Calcul le progres par automate
 
'***** DEBUT - Recherche de la colonne "Total"
a = 2
While Not Cells(1, a) = ""
a = a + 1
Wend
a = a - 1
'%%%%% FIN - Recherche de la colonne "Total"
 
'***** DEBUT - Calcul nbre total IO pour mettre dans colonne "Total"
b = 2
c = 0
Cells(2, a).Select
Selection.ClearContents
While Not Cells(2, b) = ""
If Cells(2, b) > 0 Then
c = c + Cells(2, b)
End If
b = b + 1
Wend
Cells(2, a) = c 'Ecriture du resultat dans la colonne total ligne nbre total IO
'***** FIN - Calcul nbre total IO pour mettre dans colonne "Total"
 
'***** DEBUT - Calcul nbre total IO testé pour mettre dans colonne "Total"
b = 2
c = 0
Cells(3, a).Select
Selection.ClearContents
While Not Cells(2, b) = ""
If Cells(3, b) > 0 Then
c = c + Cells(3, b)
End If
b = b + 1
Wend
Cells(3, a) = c ''Ecriture du resultat dans la colonne total ligne nbre total IO testé
'***** FIN - Calcul nbre total IO testé pour mettre dans colonne "Total"
 
'***** DEBUT - Calcul nbre total IO qui reste à testé et du progress en %, pour mettre dans colonne "Total"
Cells(4, a) = Cells(2, a) - Cells(3, a)
Cells(5, a) = Cells(3, a) / Cells(2, a)
Cells(5, a).Select
Selection.NumberFormat = "0.00%"
'***** FIN - Calcul nbre total IO qui reste à testé et du progres en %, pour mettre dans colonne "Total"
 
'***** DEBUT - Calcul des IO testé dans la semaine en cours
lignesemaine = 8
While Not Cells(lignesemaine, 1) = ""
lignesemaine = lignesemaine + 1
Wend
lignesemaine = lignesemaine - 1 'A ce point, e correspond à la semaine en cours
b = 2
While Not Cells(1, b) = ""
    While Not Cells(1, b) = "Total"
    If Cells(1, b) > 0 Then
            d = Cells(1, b)
            Sheets(d).Select
            Cells(1, 16).Activate
            ActiveCell.FormulaR1C1 = "=COUNTIF(C12,""*"")-1"
            c = Cells(1, 16)
            Selection.ClearContents
            Sheets("progress").Select
            lignesemaine = lignesemaine - 1
                While Not Cells(lignesemaine, b) = ""
                    If Cells(lignesemaine, b) > 0 Then
                    c = c - Cells(lignesemaine, b)
                    End If
                    lignesemaine = lignesemaine - 1
                Wend
            lignesemaine = 8
            While Not Cells(lignesemaine, 1) = ""
                lignesemaine = lignesemaine + 1
            Wend
            lignesemaine = lignesemaine - 1
            Cells(lignesemaine, b) = c
    End If
    b = b + 1
    Wend
    b = b + 1
Wend
b = 2
While Not Cells(1, b) = ""
If Cells(1, b) > 0 Then
b = b + 1
End If
Wend
b = b - 1
Cells(lignesemaine, b).Select
Selection.ClearContents
 
 
b = 2
c = 0
While Not Cells(1, b) = ""
If Cells(lignesemaine, b) > 0 Then
c = c + Cells(lignesemaine, b)
End If
b = b + 1
Wend
b = b - 1
Cells(lignesemaine, b) = c 'Ecriture du resultat dans la colonne total ligne nbre total IO
'***** FIN - Calcul des IO testé dans la semaine en cours
colonne = 1
ligne = 2
couleur = 15
 
While Not Cells(ligne, colonne) = ""
If Cells(ligne, colonne) >= 0 Then
Cells(ligne, colonne).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            Selection.Interior.ColorIndex = couleur
            Selection.Font.Bold = True
            End If
        ligne = ligne + 1
Wend
 
ligne = ligne + 1
While Not Cells(ligne, colonne) = ""
If Cells(ligne, colonne) >= 0 Then
Cells(ligne, colonne).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            Selection.Interior.ColorIndex = couleur
            Selection.Font.Bold = True
            End If
        ligne = ligne + 1
Wend
 
 
colonne = 2
ligne = 1
couleur = 15
 
While Not Cells(ligne, colonne) = "" And Cells(ligne, colonne) <> "Total"
    While Not Cells(1, colonne) = "" And Cells(1, colonne) <> "Total"
        If Cells(ligne, colonne) >= 0 Then
            Cells(ligne, colonne).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            Selection.Interior.ColorIndex = couleur
            Selection.Font.Bold = True
            End If
        colonne = colonne + 1
    Wend
    colonne = 2
    ligne = ligne + 1
    If Cells(ligne, colonne) >= 0 And ligne > 1 Then
        couleur = 8
    End If
Wend
 
colonne = 2
ligne = 1
couleur = 15
While Not Cells(ligne, colonne) = ""
    While Cells(ligne, colonne) = "Total"
        If Cells(ligne, colonne) = "Total" Then
        Cells(ligne, colonne).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .ShrinkToFit = False
                    .MergeCells = False
                End With
                Selection.Interior.ColorIndex = couleur
                Selection.Font.Bold = True
                End If
                colonne = colonne + 1
    Wend
    colonne = colonne + 1
    Cells(ligne, colonne).Select
Wend
 
colonne = colonne - 2
couleur = 6
If Cells(ligne, colonne) = "Total" Then
    ligne = ligne + 1
    While Not Cells(ligne, colonne) = ""
        If Cells(ligne, colonne) >= 0 Then
            Cells(ligne, colonne).Select
                    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .ShrinkToFit = False
                        .MergeCells = False
                    End With
                    Selection.Interior.ColorIndex = couleur
                    Selection.Font.Bold = True
        End If
        ligne = ligne + 1
    Wend
End If
 
colonne = 2
ligne = 7
couleur = 8
 
While Not Cells(ligne, colonne) = ""
    While Not Cells(ligne, colonne) = ""
        If Cells(ligne, colonne) >= "" Then
            Cells(ligne, colonne).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            Selection.Interior.ColorIndex = couleur
            Selection.Font.Bold = True
        End If
        colonne = colonne + 1
    Wend
    colonne = colonne - 1
    couleur = 6
    Cells(ligne, colonne).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            Selection.Interior.ColorIndex = couleur
            Selection.Font.Bold = True
    colonne = 2
    ligne = ligne + 1
    couleur = 8
Wend
 
Application.ScreenUpdating = True
End Sub

**fring** · 09/09/2008, 00h21

je m'attendais à voir un code de 10 lignes

Pour commencer, explique moi cette partie

Code :

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

1
2
3
4
5
6
7
8
While Cells(1, colonne) = ""
        If Cells(1, colonne) = 0 Then
            Cells(1, colonne).Select
            ActiveSheet.Paste
            End If
 
        Wend
        colonne = colonne + 1

D'abord, ton "colonne = colonne + 1" doit se trouver dans la boucle, avant le "Wend" sinon tu vas tourner indéfiniment sur la même cellule.
Ensuite je ne comprend pas ta condition : tant que la cellule est vide on vérifie si la cellule est égale à 0

Si la cellule est vide elle ne peut pas être = à 0
Ca ne serait pas plutôt : tant que la cellule n'est pas vide ?

[EDIT]
Finalement je ne comprend pas ce que tu veux faire pour cette partie

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
'***** DEBUT - PROGRESS - Mise à jour noms des automates avec PARAMETRES
Sheets("parametres").Select
ligne = 2
colonne = 2
While Not Cells(ligne, 1) = ""
    If Cells(ligne, 1) > 0 Then
        Cells(ligne, 1).Select
        Selection.Copy
        Sheets("progress").Select
 
        While Cells(1, colonne) = ""
        If Cells(1, colonne) = 0 Then
            Cells(1, colonne).Select
            ActiveSheet.Paste
            End If
 
        Wend
        colonne = colonne + 1
    End If
ligne = ligne + 1
Sheets("parametres").Select
Wend
Sheets("progress").Select
Cells(1, colonne) = "Total"
'***** FIN - PROGRESS - Mise à jour noms des automates avec PARAMETRES

Explique le en français parce que là ton code va apparement écrire plusieurs fois des données sur les mêmes cellules en écrasant les valeurs précédentes
.

**fring** · 09/09/2008, 01h52

Bon...ya du boulot

Je vais t'expliquer pour 2 parties de ton code, tu essayeras de corriger le reste par toi même en me supprimant TOUS ces satanés "Select"

Pour commencer, lorsque tu jongles dans 2 feuilles tout au long de ton code, initialises 2 variables en début de code, variables qui représenteront ces 2 feuilles. Ce qui permettra un codage plus aisé et une meilleure lisibilité.

Code :

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

1
2
3
4
Dim SHparam As Worksheet, SHprog As Worksheet
 
Set SHparam = Sheets("parametres")
Set SHprog = Sheets("progress")

Une fois ces variables initialisées, au lieu d'écrire

Code :

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

1
2
3
4
Sheets("parametres").Select
Range("A1") = "toto"
Sheets("progress").Select
Range("A1") = "titi"

tu peux écrire

Code :

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

1
2
SHparam.Range("A1") = "toto"
SHprog.Range("A1") = "titi"

Comme tu peux le constater, il n'y a pas de Select. Il n'est pas nécessaire de sélectionner une feuille pour lire ou écrire dans une cellule.

Ce qui donne pour ton code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
'***** DEBUT - PROGRESS - Mise à jour des numero de semaine dans les onglets "parametres" et "progress"
'######### A SUPPRIMER ##########
'# lignesemaine = 8
'# 'Recherche dans onglet progress la derniere semaine enregistré
'# Sheets("progress").Select
'# While Not Cells(lignesemaine, 1) = ""
'#         lignesemaine = lignesemaine + 1
'# Wend
'# lignesemaine = lignesemaine - 1
'################################
 
'pour trouver la dernière ligne, il suffit de faire
lignesemaine = SHprog.Cells(1, 1).End(xlDown).Row
'si c'est pour trouver la première ligne vide --> lignesemaine = SHprog.Cells(1, 1).End(xlDown).Row + 1
 
'Dans onglet parametres affiche le n° de semaine apres premier import dans semaine debut, semaine en cours et dans progress semaine en cours
'# à supprimer --> Sheets("parametres").Select
If SHparam.Range("L1") = "" Then 'remplace --> If Range("L1") = "" Then
    NumSem = DatePart("ww", Date, 2, 2)
    SHparam.Range("L1").Value = "S" & " " & NumSem '# remplace --> Range("L1").Value = "S" & " " & NumSem
    SHparam.Range("L2").Value = "S" & " " & NumSem '# remplace --> Range("L2").Value = "S" & " " & NumSem
    '# à supprimer --> Sheets("progress").Select
    SHprog.Cells(lignesemaine, 1).Value = "S" & " " & NumSem '# remplace --> Cells(lignesemaine, 1).Value = "S" & " " & NumSem
Else
    'Dans onglet parametres, affiche le n° semaine en cours si il est different du n° de début
    '# à supprimer --> Sheets("parametres").Select
    NumSem = DatePart("ww", Date, 2, 2)
    SHparam.Range("L2").Value = "S" & " " & NumSem '# remplace --> Range("L2").Value = "S" & " " & NumSem
    'Dans onglet progress, incremente le n° des semaines si different de la semaine precedente
    If SHparam.Range("L2") <> SHprog.Cells(lignesemaine, 1) Then '# remplace --> If Range("L2") <> Sheets("Progress").Cells(lignesemaine, 1) Then
        '# à supprimer --> Sheets("progress").Select
        lignesemaine = lignesemaine + 1
        NumSem = DatePart("ww", Date, 2, 2)
        SHprog.Cells(lignesemaine, 1).Value = "S" & " " & NumSem '# remplace --> Cells(lignesemaine, 1).Value = "S" & " " & NumSem
        '# à supprimer --> Sheets("parametres").Select
    End If
End If
'***** FIN - Mise à jour des numero de semaine dans les onglets "parametres" et "progress"

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
'***** DEBUT - Calcul du nombre total IO par automate
'# à supprimer --> Sheets("progress").Select
b = 2
    While SHprog.Cells(1, b) <> "" And SHprog.Cells(i, b) <> "Total" '# remplace --> While Not Cells(1, b) = "" --> et --> While Not Cells(1, b) = "Total"
        If SHprog.Cells(1, b) > 0 Then '# remplace --> If Cells(1, b) > 0 Then
            d = SHprog.Cells(1, b) '# remplace --> d = Cells(1, b)
            Sheets(d).Cells(i, 16).FormulaR1C1 = "=COUNTIF(C1,""*"")-1" '# remplace --> Sheets(d).Select --> et --> Cells(1, 16).Activate --> et --> ActiveCell.FormulaR1C1 = "=COUNTIF(C1,""*"")-1"
            SHprog.Cells(2, b) = Sheets(d).Cells(1, 16) '# remplace --> c = Cells(1, 16) --> et --> Sheets("progress").Select --> et --> Cells(2, b) = c
            Sheets(d).Cells(1, 16).ClearContents '# remplace --> Selection.ClearContents
        End If
 
        b = b + 1
        '# à supprimer --> Sheets("progress").Select
        '# à supprimer --> b = b + 1
    Wend
'%%%%% FIN - Calcul du nombre total IO par automate

Voilà dans un premier temps quelques améliorations, il y a encore moyen de faire mieux mais...il est trop tard et il faudrait connaître tous les tenants et aboutissants.
Inspire toi de ces modifications et des commentaires pour essayer de modifier le reste de ton code, si il y a quelque chose que tu ne comprend pas, fais nous signe

.
.

**zeralium** · 09/09/2008, 19h12

Merci pour tout ces conseils, je regarde tout ca.

Lancer macro 1 seul fois sur activation feuille

Macros et VBA Excel

Discussions similaires

Partager

Partager