créer une barre de progresion en VBA

[andre_lepoupon]

Bjr à tous
j'ai lu et beaucoup cherché sur le site
j'ai trouvé des morceaux de programme sans jamais en avoir un complètement

cette fois ci ma barre fonctionne et je souhaite vous la faire partager

elle se compose d'un UserForm que j'ai nommé "barre_progression"
les macros sont placées dans un module bien sûr

j'y ai ajouté une temporisation afin de bien constater l'évolution de la barre

Voici le code placé dans le module :

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Explicit
--------------------------------------------
Sub demarrage()
    barre_progression.curseur.Width = 0
    barre_progression.Show
 
End Sub
------------------------------------------------
Sub traitement()
 
    Dim compteur As Integer
    Dim LigneMax As Integer, colonnemax As Integer
    Dim r As Integer, c As Integer
    Dim valeur_curseur As Single
    Dim t As Double
 
 
    Application.ScreenUpdating = False
    ' initialisation des variables
    compteur = 1
    LigneMax = 100
    colonnemax = 25
    valeur_curseur = 0
 
 
    ' boucle pour balayer les cellules
    For r = 1 To LigneMax
        For c = 1 To colonnemax
            'Put a random number in a cell
            Cells(r, c) = Int(Rnd * 1000)
            compteur = compteur + 1
        Next c
 
        'mise à jour du curseur
        valeur_curseur = compteur / (LigneMax * colonnemax)
 
        For t = 1 To 2000000
            t = t + 1
        Next t
 
        ' appel au sous programme pour faire avancer le curseur.
        Call faire_evoluer_barre(valeur_curseur)
    Next r
 
    ' tache terminée, effacement de la barre de progression
    Unload barre_progression
 
    Application.ScreenUpdating = True
 
End Sub
 
Sub faire_evoluer_barre(valeur_curseur As Single)
    With barre_progression
 
        ' modification du titre en fonction de l'évolution
        .Caption = Format(valeur_curseur, "0%") & " du traitement effectué"
 
        ' mise à jour du curseur
        .curseur.Width = valeur_curseur * (.barre_fixe.Width - 10)
    End With
 
    ' redonne la main à windows.
    DoEvents
 
End Sub
 
 
puis dans le code du userForm placé le code suivant:
 
'barre de progression
Private Sub UserForm_Activate()
    barre_progression.curseur.Width = 0
    Call traitement
End Sub

Il vous reste à generer votre userform (barre_progression) équipé du "curseur" et de sa "barre_fixe"

dans le fichier excell, faite un bouton de commande et affectez lui la macro "Démarrage"

Appuiyer sur le bouton, et donnez moi votre avis

Cordialement