[VBA-E] Affichage de progression de processus

Après quelques recherches supplémentaires et une légère prise de tête:

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
'Dans un module standard:
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
Dim TE As Long
Dim Depart As Long
Sub Calcul()
    Depart = GetTickCount
    UserForm1.Show vbModeless
    Call Demarrer
    'Boucle qui simule un traitement long
    Do
        'pour pouvoir fermer l'userform mais effet non voulu:
        'un mouvement de la souris au dessus le l'Userform perturbe
        'son comportement
        DoEvents
        TE = (GetTickCount - Depart) / 1000
        'pour que ça ne consomme pas de cpu
        Sleep 10
    Loop While UserForm1.Visible = True
End Sub
Sub Demarrer()
    UserForm1.Label1.Caption = Format(TE)
    UserForm1.Repaint
    If UserForm1.Visible = True Then Application.OnTime Now + TimeValue("00:00:01"), "Demarrer"
End Sub

Il faut ajouter un label nommé "Label1" sur un UserForm nommé UserForm1.
Bonne soirée.