Une progressbar perso façon patosch

**curt** · 19/12/2014, 22h30

Super, joli, trop bien... What else ??

**patricktoulon** · 13/06/2019, 19h21

bonjour a tous
comme cette contribution commence a dater et qu'elle est ressortie dans un autre déterrage de post sur le forum
j'ai pris 5 minutes pour vous en faire une simple horizontale style blueseven uniquement
et surtout plus aucune api Windows ou GDI pour le transfert de la shape en image dans le control image de l'UserForm

nous disons donc dans un module standard

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
 
'******************************************************************************************************
'                        BARRE DE PROGRESSION STYLEE BLUE SEVEN SANS API
'VERSION:hors serie 2019 simplifiée
'auteur:patricktoulon
'******************************************************************************************************
Option Explicit
Sub create_slide()
     Dim bar As CommandBar
     With ActiveSheet.Shapes.AddShape(1, 10, 15, 20, 20)
        .Name = "progress"
        .Line.Visible = msoFalse
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(Red:=0, Green:=200, blue:=255)
             .Fill.OneColorGradient msoGradientHorizontal, 4, 0.1
                .Copy
        Set bar = CommandBars.Add("temp", , , True)
        With bar.Controls.Add(msoControlButton)
            .PasteFace
            Ufprogression.slide.Picture = .Picture
            Ufprogression.start = True
            Ufprogression.message.Caption = "Veuillez patienter !!" & vbCrLf & " la fin de l'execution"
        End With
        bar.Delete
        .Delete
    End With
    Ufprogression.Show 0
End Sub
'
'
Sub progression(i&, fin&)
    If Ufprogression.start = False Then create_slide
    Ufprogression.slide.Width = ((160 / fin) * i) + 10
     If i = fin Then Ufprogression.message.Caption = "Terminé !!!"
DoEvents
End Sub

une petite sub avec une boucle pour la tester

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
    Dim i As Long, fin As Long, debut As Long
    debut = 1: fin = 100000
    For i = debut To fin
        ' ton code qui fait ce que tu veux
        'blablabla
        '....
        progression i, fin
    Next
End Sub

un UserForm avec une frame de 160 de large et 12 de height
et une image de même hauteur avec 10 point de plus que la frame et un left de -10
et un label transparent pour le message

la frame se nomme "fondprogress" & l'image se nomme "slide", le label se nomme "message"

la seule ligne de code dans l'UserForm est :

Code :

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