Countdown timer on the userform.

[asyamonique]

Good Day,
Is it possible to add in my userform top corner one countdown timer with three buttons, one will start(down from two minutes) other is stop and another will be reset button?

Many Thanks

 

[Logit]

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

Option Explicit

Dim TimerID As Long
Private Sub Chrono()
Dim T As Double
    T = TimeValue(UserForm3.LblTemps.Caption) - TimeSerial(0, 0, 1)
    UserForm3.LblTemps.Caption = Format(T, "hh:mm:ss")
    If T = 0 Then TimerOff

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'As an alternative you could try making a call to a separate Sub with the sound command/s, instead of placing the code here.
 
    If UserForm3.LblTemps.Caption = "00:59:55" Then '<--- set the time for sound here
        Beep  '<-- place your command here for sound
    End If
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

End Sub
Sub TimerOff()
    KillTimer 0, TimerID
End Sub

Sub TimerOn(Interval As Long)
    TimerID = SetTimer(0, 0, Interval, AddressOf Chrono)
End Sub

Download File :
Internxt Drive – Private & Secure Cloud Storage

 

[asyamonique]

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

Option Explicit

Dim TimerID As Long
Private Sub Chrono()
Dim T As Double
    T = TimeValue(UserForm3.LblTemps.Caption) - TimeSerial(0, 0, 1)
    UserForm3.LblTemps.Caption = Format(T, "hh:mm:ss")
    If T = 0 Then TimerOff

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'As an alternative you could try making a call to a separate Sub with the sound command/s, instead of placing the code here.
 
    If UserForm3.LblTemps.Caption = "00:59:55" Then '<--- set the time for sound here
        Beep  '<-- place your command here for sound
    End If
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

End Sub
Sub TimerOff()
    KillTimer 0, TimerID
End Sub

Sub TimerOn(Interval As Long)
    TimerID = SetTimer(0, 0, Interval, AddressOf Chrono)
End Sub

Download File :
Internxt Drive – Private & Secure Cloud Storage

Hello,
Thx for the quick reply.
Having below error.

Private Declare [COLOR=rgb(235, 107, 86)]Function [/COLOR]SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

 

[Logit]

What error

 

[asyamonique]

What error

It says "The code is in that project must be updated for use 64-bit systems"

 

[Logit]

1. There should also be a line or lines of code that are highlighted in yellow. Which line / lines were they ?

2. Are you running a 64 bit copy of Windows ? Or is it a 32 bit ?

 

[asyamonique]

1. There should also be a line or lines of code that are highlighted in yellow. Which line / lines were they ?

2. Are you running a 64 bit copy of Windows ? Or is it a 32 bit ?

I've simply downloaded your file and it did not run.
Using 64bit.
Tq

 

[Logit]

Ok. I too am running Win 10 / 64 bit. However, the project runs fine here.

????

 

[asyamonique]

Ok. I too am running Win 10 / 64 bit. However, the project runs fine here.

????

 

[asyamonique]

Hello Again,
Found that below code and so far it worked in my project.
Only one think i counldn't fix when its stop actually I wanted make it disappear without click userform as;

lblCountdown = ("")

Also when its running sometimes the screen blinking )
Tq.

Private Sub lblCountdown_Click()

nTime = 0

lblCountdown = ("")

End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

nTime = nCount
Call RunTimer

End Sub

Public Const nCount As Long = 120 ' secs
Public nTime As Double


Public Sub RunTimer()


Application.ScreenUpdating = False


If nTime > 1 Then

nTime = nTime - 1
list.lblCountdown.Caption = Format(TimeSerial(0, 0, nTime), "hh:mm:ss")
Application.OnTime Now + TimeSerial(0, 0, 1), "RunTimer"
Else

End If

Application.ScreenUpdating = True


End Sub