Minuteur reprendre VBA

Bonjour,

Je n'arrive pas à faire en sorte que mon minuteur reprenne la ou il était quand je clic sur reprendre :

Dim arrêt As Boolean
Dim chrono As Date
Dim Chronodeb As Date
Dim clic As Boolean

Private Sub START_Click()

    Me.START.Visible = False: Me.PAUSE.Visible = True
    arrêt = False

    If Me.START.Caption = "START" Then
        chrono = TimeValue(Me.TextBox1 & Me.TextBox2 & ":" & Me.TextBox3 & Me.TextBox4 & ":" & Me.TextBox5 & Me.TextBox6)
        Chronodeb = chrono

    While CStr(chrono) <> "00:00:00" And Not arrêt

        Application.Wait (Now + TimeValue("00:00:01"))
        chrono = chrono - TimeValue("00:00:01")
        Me.Label1 = Format(chrono, "hh:mm:ss")
        Me.Label3.Width = 252 - (252 - 252 * (CDbl(chrono) / CDbl(Chronodeb)))

    If CStr(chrono) < "00:00:06" Then
        Me.Label3.BackColor = RGB(217, 1, 21)
        Beep
    End If

        DoEvents

    Wend

    End If

    If Me.Label1 = TimeValue("00:00:00") Then
        Me.START.Caption = "START"
        Me.Label1 = TimeValue("00:00:00")
        Me.START.Visible = True: Me.PAUSE.Visible = False
        Me.Label3.BackColor = RGB(4, 196, 4)
        Me.Label3.Width = 252
    End If

End Sub
Private Sub PAUSE_Click()

    arrêt = True
    Me.START.Caption = "REPRENDRE"
    Me.START.Visible = True: Me.PAUSE.Visible = False

clic = Me.SART.Caption = "REPRENDRE"

    If clic = True Then
    arrêt = False
    End If

End Sub

Private Sub RESET_Click()
    arrêt = True
    Me.Label1 = TimeValue("00:00:00")
    Me.START.Caption = "START"
    Me.Label3.BackColor = RGB(4, 196, 4)
    Me.Label3.Width = 252

End Sub

Private Sub TextBox1_Change()
    ctrl_un_chiffre TextBox1
End Sub
Private Sub TextBox2_Change()
    ctrl_un_chiffre TextBox2
End Sub
Private Sub TextBox3_Change()
    ctrl_un_chiffre TextBox3
End Sub
Private Sub TextBox4_Change()
    ctrl_un_chiffre TextBox4
End Sub
Private Sub TextBox5_Change()
    ctrl_un_chiffre TextBox5
End Sub
Private Sub TextBox6_Change()
    ctrl_un_chiffre TextBox6
End Sub
Private Sub ctrl_un_chiffre(ctrl As Control)
    If Len(ctrl) > 1 Then ctrl = Left(ctrl, 1): Exit Sub
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    arrêt = True
End Sub
11sport-v2.xlsm (62.08 Ko)

Goat

j'ai compris d'où venait l'erreur :

il fallait que le chrono soit juste après le then et non en dessous :

If Me.START.Caption = "START" Then chrono = TimeValue(Me.TextBox1 & Me.TextBox2 & ":" & Me.TextBox3 & Me.TextBox4 & ":" & Me.TextBox5 & Me.TextBox6)
Chronodeb = chrono 

du coup le bon code ! :

Dim arrêt As Boolean
Dim chrono As Date
Dim Chronodeb As Date
Private Sub START_Click()

    Me.START.Visible = False: Me.PAUSE.Visible = True:
    arrêt = False

    If Me.START.Caption = "START" Then chrono = TimeValue(Me.TextBox1 & Me.TextBox2 & ":" & Me.TextBox3 & Me.TextBox4 & ":" & Me.TextBox5 & Me.TextBox6)
        Chronodeb = chrono

    While CStr(chrono) <> "00:00:00" And Not arrêt

        Application.Wait (Now + TimeValue("00:00:01"))
        chrono = chrono - TimeValue("00:00:01")
        Me.Label1 = Format(chrono, "hh:mm:ss")
        Me.Label3.Width = 252 - (252 - 252 * (CDbl(chrono) / CDbl(Chronodeb)))

    If CStr(chrono) < "00:00:06" Then
        Me.Label3.BackColor = RGB(217, 1, 21)
        Beep
    End If

        DoEvents

    Wend

    If Me.Label1 = TimeValue("00:00:00") Then
        Me.START.Caption = "START"
        Me.Label1 = TimeValue("00:00:00")
        Me.START.Visible = True: Me.PAUSE.Visible = False
        Me.Label3.BackColor = RGB(4, 196, 4)
        Me.Label3.Width = 252
    End If

End Sub
Private Sub PAUSE_Click()

 arrêt = True
    Me.START.Caption = "REPRENDRE"
    Me.START.Visible = True: Me.PAUSE.Visible = False

End Sub

Private Sub RESET_Click()
    arrêt = True
    Me.Label1 = TimeValue("00:00:00")
        Me.START.Caption = "START": Me.START.Visible = True
    Me.Label3.BackColor = RGB(4, 196, 4)
    Me.Label3.Width = 252

End Sub

Private Sub TextBox1_Change()
    ctrl_un_chiffre TextBox1
End Sub
Private Sub TextBox2_Change()
    ctrl_un_chiffre TextBox2
End Sub
Private Sub TextBox3_Change()
    ctrl_un_chiffre TextBox3
End Sub
Private Sub TextBox4_Change()
    ctrl_un_chiffre TextBox4
End Sub
Private Sub TextBox5_Change()
    ctrl_un_chiffre TextBox5
End Sub
Private Sub TextBox6_Change()
    ctrl_un_chiffre TextBox6
End Sub
Private Sub ctrl_un_chiffre(ctrl As Control)
    If Len(ctrl) > 1 Then ctrl = Left(ctrl, 1): Exit Sub
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    arrêt = True
End Sub
Rechercher des sujets similaires à "minuteur reprendre vba"