How to make safe API Timers in VBA?

前端 未结 6 983
情话喂你
情话喂你 2020-12-01 21:46

I read in various places that API timers are risky in VBA, that if you edit a cell while the timer is running it will crash Excel.

This code from http://optionexplic

6条回答
  •  天涯浪人
    2020-12-01 22:36

    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:

    Option Explicit
    Option Private Module
    #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).

提交回复
热议问题