Pointer-Safe and 64-Bit declarations for the Windows Timer API in VBA
As promised, here are the 32-Bit and 64-Bit API declarations for the Timer API, using LongLong and the Safe Pointer type:
#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows
' Use LongLong and LongPtr
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As LongLong, _
ByVal lpTimerFunc As LongPtr _
) As LongLong
Public Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr _
) As LongLong
Public TimerID As LongPtr
#ElseIf VBA7 Then ' 64 bit Excel in all environments
' Use LongPtr only, LongLong is not available
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As Long) As Long
Public TimerID As LongPtr
#Else ' 32 bit Excel
Private 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
#End If
' Call the timer as:
' SetTimer 0&, 0&, lngMilliseconds, AddressOf TimerProc
#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows ' Use LongLong and LongPtr
' Note that wMsg is always the WM_TIMER message, which actually fits in a Long
Public Sub TimerProc(ByVal hwnd As LongPtr, _
ByVal wMsg As LongLong, _
ByVal idEvent As LongPtr, _
ByVal dwTime As LongLong)
On Error Resume Next
KillTimer hwnd, idEvent ' Kill the recurring callback here, if that's what you want to do
' Otherwise, implement a lobal KillTimer call on exit
' **** YOUR TIMER PROCESS GOES HERE ****
End Sub
#ElseIf VBA7 Then ' 64 bit Excel in all environments
' Use LongPtr only
Public Sub TimerProc(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal idEvent As LongPtr, _
ByVal dwTime As Long)
On Error Resume Next
KillTimer hwnd, idEvent ' Kill the recurring callback here, if that's what you want to do
' Otherwise, implement a lobal KillTimer call on exit
' **** YOUR TIMER PROCESS GOES HERE ****
End Sub
#Else ' 32 bit Excel
Public Sub TimerProcInputBox(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
On Error Resume Next
KillTimer hwnd, idEvent ' Kill the recurring callback here, if that's what you want to do
' Otherwise, implement a lobal KillTimer call on exit
' **** YOUR TIMER PROCESS GOES HERE ****
End Sub
#End If
The hwnd parameter is set to zero in the sample code above, and should always will be zero if you’re calling this from VBA instead of associating the call with (say) an InputBox or form.
A fully-worked example of this Timer API, including the use of the hwnd parameter for a window, is available on the Excellerando website:
Using the VBA InputBox for passwords and hiding the user’s keyboard input with asterisks.
Footnote:
This has been published as a separate reply to my explanation of the system errors associated with calling the Timer API without careful error-handling: it’s a separate topic, and StackOverflow will benefit from a separate and searchable answer with the Pointer-Safe and 64-Bit declarations for the Windows Timer API.
There are bad examples of the API declarations out there on the web; and there are very few examples for the common case of VBA7 (which supports the Safe Pointer type) installed on a 32-Bit Windows environment (which doesn’t support the 64-Bit ‘LongLong’ integer).
转自：
https://stackoverflow.com/questions/20269844/api-timers-in-vba-how-to-make-safe