Progress bar qui ne s'incrémente pas
Bonjour,
Je rencontre une difficulté dans la création de ma progress bar.
Mon problème : elle ne s'incrémente pas, passe de 0 à 100% directement et le pourcentage affiché ne varie pas.
Mon programme:
Objectif : J'ai une job liste générale (feuille 1 du classeur excel) que j'attribue a des personnes avec des deadlines.
Je veux trier ces infos.
Dans le même classeur je veux des onglets avec le nom des personnes.
Ainsi en faisant une macro je veux que pour chaque personne corresponde la lsite des taches qui lui sont attribuées.
La construction du programme:
Feuille 1 : liste de personne avec des taches attribuées et des deadline (nom des personnes sur la 3eme colonne de ma feuille)
Feuille 2: le nom de la personne 1
Feuille 3: le nom de la personne 2
Un bouton est mis sur feuille 1. Quand je clique dessus je lance ma macro.
La macro cherche dans ma colonne 4 le nom de la personne et en fonction que se soit personne 1 ou personne 2, la macro recopie la ligne entière correspondante dans la feuille 2 ou feuille 3 qui porte le nom de la personne.
Ma macro principale:
Code:
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
| Sub Macro1()
Dim LigneSup, L As Currency, Lig1 As Currency, Lig2 As Currency
LigneSup = Range("A65536").End(xlUp).Row
Lig1 = 1: Lig2 = 1:
For L = 4 To LigneSup
Select Case Cells(L, 4)
Case "Jean"
'-----------
Lig1 = Lig1 + 1
With Sheets("Jean")
.Cells(Lig1, 1) = Sheets("LISTE").Cells(L, 1)
.Cells(Lig1, 2) = Sheets("LISTE").Cells(L, 2)
.Cells(Lig1, 3) = Sheets("LISTE").Cells(L, 3)
.Cells(Lig1, 4) = Sheets("LISTE").Cells(L, 4)
End With
Case "Paul"
'-----------
Lig2 = Lig2 + 1
With Sheets("Paul")
.Cells(Lig1, 1) = Sheets("LISTE").Cells(L, 1)
.Cells(Lig1, 2) = Sheets("LISTE").Cells(L, 2)
.Cells(Lig1, 3) = Sheets("LISTE").Cells(L, 3)
.Cells(Lig1, 4) = Sheets("LISTE").Cells(L, 4)
End With
End Select
Next L
Sheets("LISTE").Range("A1").Select
End Sub |
Maintenant je veux voir la progression de mon calcul à l'aide d'une progress bar.
1. je crée donc un userform avec 1 frame et 1 label
2.je crée un nouveau module(module2) et je rentre le code suivant:
Code:
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
| Sub Launcher()
UserForm1.LabelProgress.Width = 0
UserForm1.Show
End Sub
Sub main()
On Error Resume Next 'Ignore les erreurs :le code ne stoppe pas.
xMySpeed = 5
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim PctDone As Single
Call UpdateProgress(0)
Counter = 1
RowMax = 700
ColMax = 25
For I = 1 To xMySpeed
Call Macro1
Next I
Counter = Counter + 1
PctDone = Counter / (RowMax * ColMax)
Call UpdateProgress(PctDone)
Call UpdateProgress(1)
Unload UserForm1
End Sub
Sub UpdateProgress(Pct)
PctColor = 750 - Round(750 * Pct, 0)
With UserForm1
.FrameProgress.Caption = Format(Pct, "0%")
.LabelProgress.Width = Pct * (.FrameProgress.Width - 10)
.LabelProgress.BackColor = RGB(0, PctColor / 3, PctColor)
.Repaint
End With
End Sub |
Et quand je run cette macro ma fenetre pour ma barre de progression s'affiche mais la barre ne s'incrémente pas elle passe de 0 à 100 en 1/2 sec...
Je souhaiterais avoir votre avis car je ne vois pas mon erreur.
Merci d'avance.
Julie
