'================================
' VBA采用Application.OnTime实现计时器
'
' http://www.cnhup.com
'================================
Public RunWhen As Double
Public Const cRunIntervalSeconds = 120 ' two minutes
Public Const cRunWhat = "TheSub" ' the name of the procedure to run
Sub StartTimer()
RunWhen = Now + TimeSerial(0,0,cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub
Sub TheSub()
StartTimer ' Reschedule the procedure
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen,Procedure:=cRunWhat, _
Schedule:=False
End Sub
'================================
' VBA采用Windows API实现计时器
'
' http://www.cnhup.com
'================================
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
Public TimerSeconds As Single
Sub StartTimer()
TimerSeconds = 1 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
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)
''''''
' This procedure is called by Windows. Put your
' code here.
''''''
End Sub