Afficher le temps qui s'écoule [Résolu]

[jess013]

Bonjour,

J'ai utlisé l'application.ontime pour qu'une macro s'éxécute après 3 minutes dans mon UserForm.

Je voudrais aussi que le 3 minutes s'affiche dans un intitulé du UserForm et qu'on voie le temps s'écouler. Après avoir essayer plusieurs, je ne trouve toujours pas comment faire.

Si quelqu'un pouvait m'aider, ce serait grandement apprécié,

Merci!

[jfontaine]

Bonjour,

Ci dessous un exemple (Affichage dans Label1)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Dim H As Date
 
H = TimeValue("0:3:0")
Label1.Caption = Format(H, "HH:MM:SS")
 
Do While Label1.Caption <> "00:00:00"
    DoEvents
    Application.Wait Now + TimeValue("0:0:1")
    H = H - TimeValue("0:0:1")
    Label1.Caption = Format(H, "HH:MM:SS")
    DoEvents
Loop

[Jean-Pierre49]

Bonjour Jérôme et bonjour jess013

Lors de ta procédure aucune action de peut être entreprise, si je me trompe

Je propose donc une solution qui ne boque pas d’autres procédures qui pourraient être en fonctionnement

Dans un Usf
-Un label (Label1)
-Un CommandButton (CommandButton1)

Dans le module de l’Usf

Code :

1
2
3
4
5
6
7
8
9
10
Option Explicit
Private Sub CommandButton1_Click()
    Depart = Time
    Temps = 3 * 60
    Call A
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    Application.OnTime Chrono, Procedure:="A", Schedule:=False
End Sub

Dans un 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
Option Explicit
                            Public Chrono                               As Date
                            Public Depart                               As Date
                            Public Temps                                As Integer
Sub Lancement()
    UserForm1.Show 0
End Sub
Sub A()
    On Error Resume Next
 
    Call B
    Chrono = Now + TimeValue("00:00:01")
    Application.OnTime Chrono, "A"
 
    DoEvents
End Sub
Sub B()
 
    Temps = Temps - 1
 
    If Temps < 0 Then
        On Error Resume Next
        Application.OnTime Chrono, Procedure:="A", Schedule:=False
        Exit Sub
    End If
 
    UserForm1.Label1.Caption = MnSc(Temps)
End Sub
Public Function MnSc(X As Integer) As String
                            Dim Mn                      As Double
                            Dim Sc                      As Double
    Mn = Int(X / 60)
    Sc = Int((X - Mn * 60))
 
    If Mn < 10 Then
        MnSc = "0" & Mn & " mn "
    Else
        MnSc = Mn & " mn "
    End If
 
    If Sc < 10 Then
        MnSc = MnSc + "0" & Sc & " Sc"
    Else
        MnSc = MnSc & Sc & " Sc"
    End If
End Function

A améliorer bien sur

Bon courage

[jess013]

Bonjour!

Merci beaucoup pour vos réponses, ça fonctionne.

Bonne journée