Private Const n As Long = 10
Private i As Long
Private evtime(0 To n) As Double
Private st(0 To n) As Currency, et(0 To n) As Currency
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
Private TimerID As Long
Private Const TimerSeconds As Single = 0.2
Private Sub doit()
Dim d As Double, t As Double
Application.StatusBar = "Running...."
DoEvents
QueryPerformanceCounter st(0)
i = 0
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf myevent)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer ' race condition
evtime(0) = d + t / 86400
QueryPerformanceCounter et(0)
End Sub
Private Sub myevent()
Dim d As Double, t As Double
QueryPerformanceCounter st(i + 1)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer ' race condition
i = i + 1
evtime(i) = d + t / 86400
QueryPerformanceCounter et(i)
If i = n Then
On Error Resume Next
KillTimer 0&, TimerID
Debug.Print vbNewLine & "=========="
Debug.Print 0, WorksheetFunction.Text(evtime(0), "m/dd/yyyy hh:mm:ss.000"), , _
Format(convertmytimer(et(0) - st(0)), "0.000000\,000")
For i = 1 To n
Debug.Print i, WorksheetFunction.Text(evtime(i), "m/dd/yyyy hh:mm:ss.000"), _
WorksheetFunction.Text(evtime(i) - evtime(i - 1), ".000"), _
Format(convertmytimer(et(i) - st(i)), "0.000000\,000")
Next
Application.StatusBar = "Done"
MsgBox "Done"
End If
End Sub