Discussion :

[thom07lamy]

Bonjour à tous,
voici une macro de mon cru permettant de gérer une barre de progression pendant un traitement.

C'est avant tout du bricolage, mais ça à le mérite de marcher:

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
Function Cree_Barre_Progression(Nom_Feuille As String) As Variant
'Cette procédure crée une barre de progression dans la feuille en paramètres,
' et renvoie les noms des trois shapes
' Nom_Feuille est la feuille où on veut afficher la barre
 
Dim cadre As Shape
Dim barre_vide As Shape
Dim barre_pleine As Shape
 
Dim liste_noms(3) As String
 
Set cadre = ThisWorkbook.Sheets(Nom_Feuille).Shapes.AddShape(msoShapeRectangle, 150, 150, 640, 200)
cadre.Name = "Cadre barre progression"
cadre.Select
Selection.Characters.Text = "Veuillez patienter, Excel effectue un traitement..."
 
With Selection.Characters.Font
     .Name = "Arial"
     .Bold = True
     .Size = 14
End With
Selection.HorizontalAlignment = xlCenter
 
Set barre_vide = ThisWorkbook.Sheets(Nom_Feuille).Shapes.AddShape(msoShapeRectangle, 220, 180, 500, 60)
barre_vide.Name = "Barre vide"
 
Set barre_pleine = ThisWorkbook.Sheets(Nom_Feuille).Shapes.AddShape(msoShapeRectangle, 220, 180, 1, 60)
barre_pleine.Name = "Barre pleine"
barre_pleine.Fill.ForeColor.SchemeColor = 17
 
'Pour actualiser l'écran, à améliorer...
Application.SendKeys "F5"
 
Cree_Barre_Progression = Array(cadre.Name, barre_vide.Name, barre_pleine.Name)
 
End Function
 
Sub Suppr_Barre_Progression(Nom_Feuille As String, Liste_Barre As Variant)
'Cette procédure supprime la barre de progression dans la feuille en paramètres,
' et renvoie un booléen
' Nom_Feuille est la feuille où on veut afficher la barre
' Liste_Barre est un tableau avec les noms des Shapes composant la barre
 
'---Erreur ignorée systématiquement
'---Procédure à intégrer dans du code sans ErrorHandler
On Error Resume Next
'On supprime tous les shapes dont le nom fait partie des paramètres
ThisWorkbook.Sheets(Nom_Feuille).Shapes(Liste_Barre(0)).Delete
ThisWorkbook.Sheets(Nom_Feuille).Shapes(Liste_Barre(1)).Delete
ThisWorkbook.Sheets(Nom_Feuille).Shapes(Liste_Barre(2)).Delete
 
On Error GoTo 0
 
End Sub
 
Sub MaJ_Barre_Progression(Nom_Feuille As String, Liste_Barre As Variant, Avancement As Integer)
'Cette procédure agrandit la barre de progression dans la feuille en paramètres,  et renvoie un booléen
' Nom_Feuille est la feuille où on veut afficher la barre
' Liste_Barre est un tableau avec les noms des Shapes composant la barre
' Avancement est le pourcentage
 
Dim taille_barre_vide As Integer
Dim taille_barre_pleine As Integer
 
taille_barre_vide = ThisWorkbook.Sheets(Nom_Feuille).Shapes(Liste_Barre(1)).Width
taille_barre_pleine = Int(Avancement / 100 * taille_barre_vide)
 
ThisWorkbook.Sheets(Nom_Feuille).Shapes(Liste_Barre(2)).Width = taille_barre_pleine
 
'Pour actualiser l'écran, à améliorer...
Application.SendKeys "F5"
 
End Sub

Dans l'utilisation, je mets Cree_Barre_Progression avant ma boucle, Suppr_Barre_Progression après, et MaJ_Barre_Progression dans la boucle, juste avant l'incrémentation de mon parcours.

Remarque: Pour pouvoir utiliser ce code, il faut pouvoir évaluer l'avancement... Par exemple, je fais:

Code :

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

1
2
nb_enreg = rs.RecordCount
num_lig = 1

avant la boucle, puis ensuite:

Code :

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

1
2
3
4
num_lig = num_lig + 1
progression = Int(num_lig / nb_enreg * 100)
Call MaJ_Barre_Progression("Données", barre_progression, progression)
Liste_Article.MoveNext

Ce code peut être optimisé, aussi je vous invite à commenter... Surtout pour le SendKeys que j'aimerais remplacer par autre chose...

[thom07lamy]

Bonjour à tous,
finalement la solution optimale que j'ai trouvé passe par un UserForm.

J'ai trouvé soit dit en passant un contrôle ProgressBar (on peut l'ajouter en faisant un clic droit sur la palette d'outil VBA "Contrôles Supplémentaires"->"Microsoft ProgressBar...").

Voici mon 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
 
Sub Cree_Barre_Progression()
'Cette procédure affiche le formulaire frmBarreProgression,
' et réinitialise la barre ctrlBarreProgression
Load frmBarreProgression
 
frmBarreProgression.ctrlBarreProgression.Value = 0
 
'Le vbModeless permet au programme de continuer son exécution,
' sinon il considère le userform comme une boîte de dialogue
frmBarreProgression.Show (vbModeless)
 
frmBarreProgression.Repaint
 
End Sub
 
Sub Suppr_Barre_Progression()
'Cette procédure masque le formulaire frmBarreProgression
frmBarreProgression.Repaint
 
frmBarreProgression.Hide
 
Unload frmBarreProgression
 
End Sub
 
Sub MaJ_Barre_Progression(Avancement As Integer)
'Cette procédure met à jour la barre de progression dans frmBarreProgression,
' Avancement est le pourcentage
 
frmBarreProgression.Repaint
 
frmBarreProgression.ctrlBarreProgression.Value = Avancement
 
End Sub

Pour l'utilisation:

Code :

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

Call Cree_Barre_Progression

Code :

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

1
2
3
'On rafraichit la barre de progression
        progression = Int(num_lig / nb_enreg * 100)
        Call MaJ_Barre_Progression(progression)

Code :

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

Call Suppr_Barre_Progression

Là, c'est du code bien plus simple, et surtout on gagne du temps sur la boucle (on passe de 2-3 min à 1.5-2 min pour un traitement de 2500 lignes).

Voilà, voilà...