Discussion :

[franc83]

Bonjour

Je reviens sur le site ,je ne m'en étais pas aperçu de suite comme le nez au milieu du visage, mais le code du compteur que Theze m'a gentiment proposé passe par 4:99 alors que je décompte des minutes et des secondes.Je remets son code
merci

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Declare Function GetTickCount Lib "Kernel32" () As Long
 
 
Dim Arret As Boolean
 
Sub Minuterie(Milliseconde As Long)
 
    Dim Fin As Long
 
    Fin = GetTickCount() + Milliseconde
 
    Do While GetTickCount() < Fin And Arret = False
 
        'décompte dans le label
        LblClock.Caption = Format((Fin - GetTickCount()) / 1000, "00:00")
 
        DoEvents
 
    Loop
 
End Sub
 
Private Sub UserForm_Initialize()
 
    'label à zéro
    LblClock.Caption = "00:00"
 
End Sub
 
Private Sub CmdArret_Click()
 
    'arrête le décompte
    Arret = True
 
End Sub
 
Private Sub CmdMarche_Click()
 
    'vide le label
    LblClock.Caption = ""
 
    'autorise le décompte
    Arret = False
 
    'pour le test, 5 minutes
    Minuterie 500000
 
End Sub
 
Private Sub CmdReset_Click()
 
    'label à zéro
    LblClock.Caption = "00:00"
 
    'arrête le décompte
    Arret = True
 
End Sub

[mercatog]

Bonjour

Remplace la ligne correspondante par ceci

Code :

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

1
2
'décompte dans le label
        LblClock.Caption = Format(TimeSerial(0, 0, (Fin - GetTickCount()) / 1000), "nn:ss")

Sinon, en utilisant Timer

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
37
38
39
40
41
42
Dim Arret As Boolean
 
Sub Minuterie(ByVal MesMinutes As Integer)
Dim Fin As Double
 
Fin = Timer + 60 * MesMinutes
Do While Timer < Fin And Not Arret
    'décompte dans le label
    LblClock.Caption = Format(TimeSerial(0, 0, Fin - Timer), "nn:ss")
    DoEvents
Loop
End Sub
 
Private Sub UserForm_Initialize()
 
'label à zéro
LblClock.Caption = "00:00"
End Sub
 
Private Sub CmdArret_Click()
 
'arrête le décompte
Arret = True
End Sub
 
Private Sub CmdMarche_Click()
 
'vide le label
LblClock.Caption = ""
'autorise le décompte
Arret = False
'pour le test, 5 minutes
Minuterie 5
End Sub
 
Private Sub CmdReset_Click()
 
'label à zéro
LblClock.Caption = "00:00"
'arrête le décompte
Arret = True
End Sub

[franc83]

Bonjour mercatog
Le remplacement par "nn:ss" cela ne marche pas.

Ton code est intéressante ,mais peut-on mettre Timer en pause?
Je suis arrivé une solution ,mais je suis obligé de mettre un Label4 supplémentaire pour avoir dans ce Label4 le Format désiré "mm:ss"

merci

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
'code Userform
Option Explicit
 
Dim EnMarche As Boolean
 
Private Sub ComboBox()
 
End Sub
Private Sub ListeBox1_Change()
Me.Label1.Caption = ListeBox1.Value
Label1.Caption = Format(Label1, "00:00:00")
End Sub
 
Private Sub CommandButton1_Click()
   If EnMarche = False Then
     TimerOn 100
     EnMarche = True
     CommandButton1.Caption = "Pause"
    Else
      CommandButton1.Caption = "Marche"
      EnMarche = False
      TimerOff
   End If
 
End Sub
 
 
Private Sub CommandButton3_Click()
  EnMarche = False
  TimerOff
  Label1.Caption = ListeBox1.Value
  Label1.Caption = Format(Label1, "00:00:00")
  Label2.Caption = "0"
  TimerOff
End Sub

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
'Code Module
Private Declare Function SetTimer Lib "User32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "User32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Dim TimerID As Long
Sub TestChrono()
UserForm1.Show
End Sub
Sub TimerOff()
  KillTimer 0, TimerID
 
End Sub
Sub TimerOn(Interval As Long)
  TimerID = SetTimer(0, 0, Interval, AddressOf Chrono)
 
End Sub
Sub Chrono()
Dim H, DS
DS = CByte(UserForm1.Label2.Caption) + 1
UserForm1.Label2.Caption = CStr(DS)
If (DS Mod 10) = 0 Then
  H = TimeValue(UserForm1.Label1.Caption) - TimeSerial(0, 0, 1)
  'Impossible de changer le format Label1 en "nn:ss" cela ne marche pas
  UserForm1.Label1.Caption = Format(H, "hh:mm:ss")
  UserForm1.Label4.Caption = Format(H, "mm:ss")
  UserForm1.Label2.Caption = 0
  End If
If TimeValue(UserForm1.Label1.Caption) = 0 Then
   Beep
     EnMarche = False
  TimerOff
 
End If
End Sub