Таймер на 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 

Я хотел бы написать код, показывающий таймер, сколько времени пользователь работает на Рабочем листе.

Пример: кнопка запуска в листе 1, когда пользователь нажимает кнопку запуска, затем активирует лист2, затем таймер будет запускаться в ячейке A1. если таймер составляет 30 минут, тогда рабочая книга сохраняет & близко.

Answer 1

Попробуйте

Создать кнопку и назначить следующий макрос

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 

Благодаря Dick Kusleika См Example