Timer on Excel VBA

Question

Dim StartTime As Date
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long

Sub StartTimer()
'~~ Set the timer for 1 second
TimerSeconds = 1
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

'~~> End Timer
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'~~> Update value in Sheet 1
Sheet1.Range("H6").Value = Time - StartTimer
End Sub
Public Sub sheet()
Sheets("1").Activate
StartTime = Time
Call Module1.StartTimer
End Sub

I would like to write a code which show timer how much time user working on the Worksheet.

Example there is a start button in sheet1 when user click on start button then it will active sheet2 then a timer will run in cell A1. if the timer is 30 min then the workbook save & close.

There are many ways to do this, depending on what you need it for. Show us your code, or your effort so far, and then we can help. — vacip
– vacip, Commented Jun 18, 2015 at 13:23
Did you get stuck with this, or are you asking for the whole code? — Nahuel Ianni
– Nahuel Ianni, Commented Jun 18, 2015 at 13:24
Actully i wrote some code while trying to test the code, file get hanged & now I am unable to open that file. It's showing file is get locked. — Developer_World
– Developer_World, Commented Jun 18, 2015 at 14:25

Community · Accepted Answer · 2017-05-23 12:16:07Z

1

Try this

Create Button and assign to the following macro

Option Explicit
Sub NewTimer()
    Dim Start As Single
    Dim Cell As Range
    Dim CountDown As Date

    '// Store timer as variable
    Start = Timer

    '// Format cell A1 to 24Hrs eg: 00:00:00
    With Range("A1")
        .NumberFormat = "HH:MM:SS;@"
    End With
    Set Cell = Sheet1.Range("A1")

    '// This is the starting value. 30 Second
    CountDown = TimeValue("00:00:30")

    '// Set cell to the starting value
    Cell.Value = CountDown

    'Keep looping until A1 hits zero or
    Do While Cell.Value > 0
        'Update the cell. Timer - Starting number is seconds
        Cell.Value = CountDown - TimeSerial(0, 0, Timer - Start)
        DoEvents
    Loop

    ThisWorkbook.Save
    ThisWorkbook.Close
    Application.Quit

End Sub

Thanks to Dick Kusleika See Example

edited May 23, 2017 at 12:16

CommunityBot

11 silver badge

answered Jun 19, 2015 at 2:01

0m3r

12.5k15 gold badges40 silver badges77 bronze badges

Sign up to request clarification or add additional context in comments.

Collectives™ on Stack Overflow

Timer on Excel VBA

1 Answer 1

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related