countdown timer

[rubac]

A long time ago JoeMo posted code for userform countdown timer which works very well. But a question was asked about including code for pause and resume command buttons. My question is : has anyone looked into
including those buttons? Here is the code :


Public AllowedTime As Variant
Sub Open_count ()
AllowedTime = InputBox("Enter the time interval to countdown")
If AllowedTime = "" Then Exit Sub
UserForm2.Show
End Sub

Private Sub UserForm_Initialize()
Dim M As Double, S As Double
M = Int(CDbl(AllowedTime))
S = (CDbl(AllowedTime) - Int(CDbl(AllowedTime))) * 60
With tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With
End Sub



I dont have that second command butto i my userform

Private Sub CommandButton1_Click()
Dim t, E, M As Double, S As Double
'AllowedTime is set in sub 'modTestUserForm' for this user form
t = Timer
Do
'next If-End If protects in case clock was started just before midnight and Timer resets during countdown
If Timer - t < 0 Then
Unload UserForm1
MsgBox "Error encountered - start again"
Exit Sub
End If
E = CDbl(Time) * 24 * 60 * 60 - t 'elapsed time in secs
M = CDbl(AllowedTime) - 1 - Int(E / 60)
S = 59 - Round((E / 60 - Int(E / 60)) * 60, 0)
With tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With
DoEvents
Loop Until (Timer - t) / 60 >= CDbl(AllowedTime) Or UserForm1.Visible = False 'i.e. Cancel clicked during countdown
Unload UserForm1
Beep
MsgBox "Time is Up!"
End Sub

 

[Logit]

Here's a multi-feature timer. Countdown or CountUp.

Private Sub CommandButton1_Click()
TimerUp
End Sub

Private Sub CommandButton2_Click()
DisableTimerUp
End Sub

Private Sub CommandButton3_Click()
If L_H.Caption = 0 And L_M.Caption = 0 And L_S.Caption = 0 Then
MsgBox "There is nothing to countdown"
Exit Sub
End If
TimerDown
End Sub

Private Sub CommandButton4_Click()
DisableTimerDown
End Sub

Private Sub CommandButton5_Click()
DisableTimerUp
DisableTimerDown
L_S.Caption = "00"
L_M.Caption = "00"
L_H.Caption = 0
End Sub

Private Sub SpinButton1_SpinUp()
L_S.Caption = Format(L_S.Caption + 1, "00")
If L_S.Caption = 60 Then
L_S.Caption = "00"
L_M.Caption = Format(L_M.Caption + 1, "00")
End If
If L_M.Caption = 60 Then
L_M.Caption = "00"
L_H.Caption = L_H.Caption + 1
End If
End Sub

Private Sub SpinButton1_SpinDown()
If L_H.Caption = 0 Then
GoTo FinishB
Else
    L_S.Caption = Format(L_S.Caption - 1, "00")
    If L_S.Caption = -1 Then
    L_S.Caption = 59
    L_M.Caption = Format(L_M.Caption - 1, "00")
    End If
    If L_M.Caption = -1 Then
    L_M.Caption = 59
    L_H.Caption = L_H.Caption - 1
    End If
End If
Exit Sub
FinishB:
If L_M.Caption = 0 Then
GoTo FinishC
Else
    L_S.Caption = Format(L_S.Caption - 1, "00")
    If L_S.Caption = -1 Then
    L_S.Caption = 59
    L_M.Caption = Format(L_M.Caption - 1, "00")
    End If
    If L_M.Caption = -1 Then
    L_M.Caption = 59
    L_H.Caption = L_H.Caption - 1
    End If
End If
Exit Sub
FinishC:
If L_S.Caption = 0 Then Exit Sub
L_S.Caption = Format(L_S.Caption - 1, "00")
End Sub

Private Sub SpinButton2_SpinUp()
L_M.Caption = Format(L_M.Caption + 1, "00")
If L_M.Caption = 60 Then
L_M.Caption = "00"
L_H.Caption = L_H.Caption + 1
End If
End Sub

Private Sub SpinButton2_SpinDown()
If L_H.Caption = 0 Then
GoTo FinishB
Else
    L_M.Caption = Format(L_M.Caption - 1, "00")
    If L_M.Caption = -1 Then
    L_M.Caption = 59
    L_H.Caption = L_H.Caption - 1
    End If
End If
Exit Sub
FinishB:
If L_M.Caption = 0 Then Exit Sub
L_M.Caption = Format(L_M.Caption - 1, "00")
End Sub

Private Sub SpinButton3_SpinUp()
If L_H.Caption = 99 Then
MsgBox "Realy!!!!"
Exit Sub
End If
L_H.Caption = L_H.Caption + 1
End Sub

Private Sub SpinButton3_SpinDown()
If L_H.Caption = 0 Then Exit Sub
L_H.Caption = L_H.Caption - 1
End Sub

Private Sub UserForm_Terminate()
DisableTimerUp
DisableTimerDown
End Sub

Download workbook : Click Here

 

[rubac]

this is great! thanks

 

[Logit]

You are welcome.