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
|
Sub ProgressBar()
Dim Fe As Worksheet
Dim Ctrl As OLEObject
Dim LblProgress As MSForms.Label
Dim LblFond As MSForms.Label
Dim LargeurLabel As Integer
Dim HauteurLabel As Integer
Dim Max As Long
Dim R As Single
Dim I As Long
Dim J As Long
Set Fe = Worksheets("Feuil1")
'défini les dimensions
LargeurLabel = 500
HauteurLabel = 20
Max = 1000 '<-- pour le test...
With Fe
Application.ScreenUpdating = False
'crée le label servant de fond
Set Ctrl = .OLEObjects.Add("Forms.Label.1")
'passe l'objet à la variable afin d'utiliser les propriétés des labels
Set LblFond = Ctrl.Object
'défini certaines de ces dernières
With LblFond
.Name = "LblFond"
.Caption = ""
.BackColor = &HC0FFFF
.BorderStyle = fmBorderStyleSingle
.Left = Application.UsableWidth / 2 - LargeurLabel / 2
.Top = Application.UsableHeight / 2
.Width = LargeurLabel
.Height = HauteurLabel
End With
'crée le label servant de barre de progression
Set Ctrl = .OLEObjects.Add("Forms.Label.1")
'idem que plus haut
Set LblProgress = Ctrl.Object
With LblProgress
.Name = "LblProgress"
.Caption = ""
.BorderStyle = fmBorderStyleSingle
.BackColor = &H800000
.ForeColor = &HFFFFFF
.Left = Application.UsableWidth / 2 - LargeurLabel / 2
.Top = Application.UsableHeight / 2
.Width = 0
.Height = HauteurLabel
.TextAlign = fmTextAlignCenter
End With
Application.ScreenUpdating = True
'rapport
R = LargeurLabel / Max
'####################################################################
'ici se fait la progression ...
'il faut adapter au code...
For J = 1 To Max
LblProgress.Width = J * R
DoEvents
LblProgress.Caption = Format(J / Max, "#0%")
Next J
'####################################################################
'suppression des labels
On Error Resume Next
.OLEObjects("LblProgress").Delete
.OLEObjects("LblFond").Delete
End With
End Sub |
Partager