如何在 VBA 中制作安全的 API 计时器？

How to make safe API Timers in VBA?

提问by Cool Blue

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.

我在很多地方都读到 VBA 中的 API 计时器有风险，如果您在计时器运行时编辑单元格，它会使 Excel 崩溃。

This code from http://optionexplicitvba.wordpress.comwritten by Jordan Goldmeier does not seem to have this problem. It fades a pop-up using the timer and while its fading, I can click and enter text in cells and the formula bar.

Jordan Goldmeier 编写的来自http://optionexplicitvba.wordpress.com 的这段代码似乎没有这个问题。它使用计时器淡出一个弹出窗口，当它淡出时，我可以单击并在单元格和公式栏中输入文本。

When is the API timer safe and when is it not? Are there some specificprinciples to help me understand? And what is the mechanism of the crash: what is happening exactly to make Excel crash?

API 计时器什么时候安全，什么时候不安全？有什么具体的原则可以帮助我理解吗？ 崩溃的机制是什么：究竟发生了什么导致 Excel 崩溃？

Option Explicit
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
Public bTimerEnabled As Boolean
Public iCounter As Integer
Public bComplete As Boolean

Public EventType As Integer

Public Sub Reset()
    With Sheet1.Shapes("MyLabel")
        .Fill.Transparency = 0
        .Line.Transparency = 0
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
    End With
    Sheet1.Shapes("MyLabel").Visible = msoTrue
End Sub

Sub StartTimer()
    iCounter = 1
    Reset
    TimerID = SetTimer(0&, 0&, 0.05 * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()
    KillTimer 0&, TimerID
    bTimerEnabled = False
    bComplete = True
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
    ByVal nIDEvent As Long, ByVal dwTimer As Long)

    On Error Resume Next

    Debug.Print iCounter
    If iCounter > 50 Then
        With Sheet1.Shapes("MyLabel")
            .Fill.Transparency = (iCounter - 50) / 50
            .Line.Transparency = (iCounter - 50) / 50
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = _
                RGB((iCounter - 50) / 50 * 224, _
                     (iCounter - 50) / 50 * 224, _
                     (iCounter - 50) / 50 * 224)
        End With
    End If

    If iCounter > 100 Then
        Sheet1.Shapes("MyLabel").Visible = msoFalse
        EndTimer
    End If

    iCounter = iCounter + 1
End Sub

Public Function ShowPopup(index As Integer)

    Sheet1.Range("Hotzone.Index").Value = index

    iCounter = 1

    If bTimerEnabled = False Then
        StartTimer
        bTimerEnabled = True
        Reset
    Else
        Reset
    End If

    With Sheet1.Shapes("MyLabel")
        .Left = Sheet1.Range("Hotzones").Cells(index, 1).Left + _
            Sheet1.Range("Hotzones").Cells(index, 1).Width
        .Top = Sheet1.Range("Hotzones").Cells(index, 1).Top - _
                (.Height / 2)
    End With
    Sheet1.Range("a4:a6").Cells(index, 1).Value = index

End Function

采纳答案by Nigel Heffernan

@CoolBlue: And what is the mechanism of the crash: what is happening exactly to make Excel crash?

@CoolBlue：崩溃的机制是什么：究竟发生了什么导致 Excel 崩溃？

I can can give you an expansion of Siddarth Rout's answer, but not a complete explanation.

我可以给你扩展 Siddarth Rout 的答案，但不是完整的解释。

API calls are not VBA: they exist outside VBA's error-handlers and when things go wrong they will either do nothing, or call on a resource in memory that doesn't exist, or attempt to read (or write!) to memory that's outside the designated memory space for Excel.exe

API 调用不是 VBA：它们存在于 VBA 的错误处理程序之外，当出现问题时，它们要么什么也不做，要么调用内存中不存在的资源，或者尝试读取（或写入！）到外部的内存Excel.exe 的指定内存空间

When that happens, the Operating System will step in and shut your application down. We used to call this a 'General Protection Fault' and that's still a useful description of the process.

发生这种情况时，操作系统将介入并关闭您的应用程序。我们过去称其为“一般保护故障”，这仍然是对该过程的有用描述。

Now for some details.

现在了解一些细节。

When you call a function in VBA, youjust write the name - let's call it 'CheckMyFile()' - and that's all you need to know within VBA. If there's nothing called 'CheckMyFile' to call, or it's declared where your call can't see it, the compiler or the runtime engine will raise an error in the form of a breakpoint, or a warning before it compiles and runs.

当您在 VBA 中调用函数时，您只需写下名称——我们称之为“CheckMyFile()”——这就是您在 VBA 中需要知道的全部内容。如果没有任何名为 'CheckMyFile' 的东西可以调用，或者在您的调用看不到它的地方声明了它，编译器或运行时引擎将在编译和运行之前以断点或警告的形式引发错误。

Behind the scenes, there's a numeric address associated with the string 'CheckMyFile': I'm simplifying a bit, but we refer to that address as a Function Pointer- follow that address, and we get to a structured block of memory that stores definitions of the function parameters, space for their stored values and, behind that, addresses directing those parameters into the functional structures created to execute your VBA and return values to the address for the function's output.

在幕后，有一个与字符串“CheckMyFile”相关联的数字地址：我稍微简化了一点，但我们将该地址称为函数指针- 按照该地址，我们将进入存储定义的结构化内存块函数参数、它们存储值的空间以及在此之后的地址，这些地址将这些参数引导到为执行 VBA 而创建的函数结构中，并将值返回到函数输出的地址。

Things can go wrong, and VBA does a lot of work to ensure that all this folds up gracefully when they do go wrong.

事情可能会出错，VBA 做了很多工作来确保所有这些在出错时都能优雅地折叠起来。

If you give that function pointer to something that isn't VBA - an external application or (say) an API Timer Call- your function can still be called, it can still run, and everything will work.

如果您将该函数指针提供给非 VBA 的东西——外部应用程序或（例如）API 计时器调用——您的函数仍然可以被调用，它仍然可以运行，并且一切都会正常进行。

We refer to this as a 'Callback' when you hand the function pointer to the API, because you call its timer function, and it calls you back.

当您将函数指针传递给 API 时，我们将其称为“回调”，因为您调用它的计时器函数，它会回调您。

But there had better be a valid function behind that pointer.

但是最好在那个指针后面有一个有效的函数。

If there isn't, the external application will call its own error-handlers, and they won't be as forgiving as VBA.

如果没有，外部应用程序将调用自己的错误处理程序，它们不会像 VBA 那样宽容。

It might just drop the call and do nothing if Excel and VBA are in a 'busy' state or otherwise unavailable when it tries to use that function pointer: you might be lucky, just that once. But it might call down the wrath of the operating system on the Excel.exe process.

如果 Excel 和 VBA 处于“忙碌”状态或在尝试使用该函数指针时不可用，它可能只是挂断电话而不做任何事情：您可能很幸运，就那么一次。但它可能会降低操作系统对 Excel.exe 进程的愤怒。

If the callback results in an error, and that error isn't handled by your code, VBA will raise the error to the caller - and, as the caller isn't VBA, it'll probably have no way of handling that: and it'll call for 'help' from the operation system.

如果回调导致错误，并且您的代码未处理该错误，则 VBA 会将错误报告给调用者 - 由于调用者不是 VBA，它可能无法处理：和它会向操作系统寻求“帮助”。

If it's an API call, it was written for developers who are assumed to have put the error-handling and contingency management in place in the calling code.

如果是 API 调用，则它是为假定已将错误处理和应急管理置于调用代码中的开发人员编写的。

Those assumptions are:

这些假设是：

1. There will definitely be a valid function behind that pointer;
2. It definitely be available when it is called;
3. ...And it will raise no errors to the caller.

1. 该指针后面肯定会有一个有效的函数；
2. 它在被调用时肯定可用；
3. ...它不会给调用者带来任何错误。

With an API callback, caller isthe operating system, and its response to detecting an error will be to shut you down.

对于 API 回调，调用者是操作系统，它对检测到错误的响应将关闭您。

So that's a very simple outline of the process - a 'why' rather than a 'what' explanation of it.

所以这是该过程的一个非常简单的概述 - 对它的“为什么”而不是“什么”解释。

The full explanation, without the oversimplifications, is for C++ developers. If you really want the answer in depth, you must learn to program with pointers; and you must become fluent with the concepts and practice of memory allocation, exceptions, the consequences of a bad pointer and the mechanisms used by an operating system to manage running applications and detect an invalid operation.

没有过度简化的完整解释是针对 C++ 开发人员的。如果你真的想要深入的答案，你必须学会​​用指针编程；并且您必须熟悉内存分配、异常、错误指针的后果以及操作系统用于管理正在运行的应用程序和检测无效操作的机制的概念和实践。

VBA exists to shield you from that knowledge and simplify the task of writing applications.

VBA 的存在是为了让您了解这些知识并简化编写应用程序的任务。

回答by Nigel Heffernan

Pointer-Safe and 64-Bit declarations for the Windows Timer API in VBA:

VBA 中 Windows 计时器 API 的指针安全和 64 位声明：

As promised, here are the 32-Bit and 64-Bit API declarations for the Timer API, using LongLong and the Safe Pointer type:

正如所承诺的，以下是 Timer API 的 32 位和 64 位 API 声明，使用 LongLong 和安全指针类型：

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.

hwnd 参数在上面的示例代码中设置为零，如果您从 VBA 调用它而不是将调用与（例如）输入框或表单相关联，则应该始终为零。

A fully-worked example of this Timer API, including the use of the hwnd parameter for a window, is available on the Excellerando website:

Excellerando 网站上提供了此 Timer API 的完整示例，包括对窗口使用 hwnd 参数：

Using the VBA InputBox for passwords and hiding the user's keyboard input with asterisks.

使用 VBA InputBox 作为密码并用星号隐藏用户的键盘输入。

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.

这已作为对我对与调用 Timer API 相关的系统错误的解释的单独回复而发布，而无需仔细处理错误：这是一个单独的主题，StackOverflow 将受益于 Pointer-Safe 和 64- 的单独且可搜索的答案Windows 计时器 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).

网上有一些关于 API 声明的不好的例子；对于安装在 32 位 Windows 环境（不支持 64 位“LongLong”整数）上的 VBA7（支持安全指针类型）的常见情况，很少有示例。

回答by Siddharth Rout

I read in various places that API timers are risky in VBA

我在很多地方都读到 VBA 中的 API 计时器有风险

Well the statement should be I read in various places that API timers are risky? And the reason why I say that is because these APIs can be use in VB6/VBA/VB.Net etc..

那么语句应该是I read in various places that API timers are risky？我之所以这么说是因为这些 API 可以在 VB6/VBA/VB.Net 等中使用。

So are they risky? Yup they are but then so is tight rope walking. One false move and you are done. And this is not the case with just SetTimer APIbut with almost any API.

那么他们有风险吗？是的，他们是，但紧绳行走也是如此。一个错误的举动，你就完成了。SetTimer API几乎任何 API都不是这种情况。

I created an example way back in 2009 which uses SetTimer APIto create splash screens in Excel. Here is the LINK.

我在 2009 年创建了一个示例方法，用于SetTimer API在 Excel 中创建启动画面。这是链接。

Now if you extract the files and you directly open the excel file then you will see that Excel Crashes. To make it work, press the SHIFTkey and then open Excel so that the macros don't run. Next change the path of the images. The new path would be the path of the images that you extracted from the zip file. once you change the path, simply save and close the file. Next time when you run it, Excel won't crash.

现在，如果您提取文件并直接打开 excel 文件，那么您将看到 Excel 崩溃。要使其工作，请按SHIFT键，然后打开 Excel，这样宏就不会运行。接下来更改图像的路径。新路径将是您从 zip 文件中提取的图像的路径。更改路径后，只需保存并关闭文件即可。下次运行它时，Excel 不会崩溃。

Here is the code in the Excel file

这是Excel文件中的代码

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.
    TimerSeconds = 1
    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)
    If tim = False Then
        UserForm1.Image1.Picture = LoadPicture("C:\temp.bmp")
        tim = True
    Else
        UserForm1.Image1.Picture = LoadPicture("C:\temp.bmp")
        tim = False
    End If
    Counter = Counter + 1
    If Counter = 10 Then
        EndTimer
        Unload UserForm1
    End If
End Sub

When is the API timer safe and when is it not? Are there some broad principles to help me understand?

API 计时器什么时候安全，什么时候不安全？是否有一些广泛的原则可以帮助我理解？

So it all boils down to one fact. How robust is your code. If your code handles every scenario, then the SetTimer APIor as a matter of fact any API will not fail.

所以这一切都归结为一个事实。你的代码有多健壮。如果您的代码处理所有场景，那么SetTimer API事实上任何 API 都不会失败。

回答by Jordan Goldmeier

@CoolBlue I wrote the code you posted above. It's true that APIs can act unpredictably, at least compared to normal code. However, if your code is robust enough (following @Siddharth Rout's comments from above), then it's no longer a prediction. In fact, that unpredictability comes in during development.

@CoolBlue 我写了你上面发布的代码。API 的行为确实是不可预测的，至少与普通代码相比是这样。但是，如果您的代码足够健壮（遵循上面@Siddharth Rout 的评论），那么它就不再是预测。事实上，这种不可预测性是在开发过程中产生的。

For example, in my first iteration of the rollover popup created above, I had accidentally typed KillTimer in the IF statement. Basically, where EndTimer exists now I had written KillTimer. I did this without thinking. I knew I had a procedure that would end the timer, but I momentarily confused EndTimer with KillTimer.

例如，在上面创建的翻转弹出窗口的第一次迭代中，我不小心在 IF 语句中键入了 KillTimer。基本上，现在 EndTimer 存在的地方我已经写了 KillTimer。我不假思索地做了这件事。我知道我有一个程序可以结束计时器，但我暂时将 EndTimer 与 KillTimer 混淆。

So here's why I bring this up: typically, when you make this type of mistake in Excel, you'd receive a runtime error. However, because you are working with APIs, you just get an illegal error, and the entire Excel application becomes unresponsive and quits. So, if you haven't saved before starting the timer, you lose everything (which is essentially what happened to me the first time through). Worse, because you don't receive a runtime error, you won't know immediately which line caused the error. In a project like this, you have to expect several illegal errors (and subsequent reloading of Excel) to diagnose the error. It can be a painful process, sometimes. But this is a typical debugging situation that happens when you worki with APIs. That the errors are not highlighted directly - and illegal errors appear to happen at random - are why many have described APIs as unpredictable and risky.

所以这就是我提出这个的原因：通常，当您在 Excel 中犯这种类型的错误时，您会收到一个运行时错误。但是，因为您正在使用 API，所以您只会收到非法错误，并且整个 Excel 应用程序变得无响应并退出。所以，如果你在开始计时之前没有保存，你就会失去一切（这基本上是我第一次发生的事情）。更糟糕的是，因为您没有收到运行时错误，所以您不会立即知道是哪一行导致了错误。在这样的项目中，您必须预料到几个非法错误（以及随后的 Excel 重新加载）来诊断错误。有时，这可能是一个痛苦的过程。但这是您使用 API 时发生的典型调试情况。

But they're not risky, so long as you can find and diagnose errors. In my code above, I believe I've created an essentially closed form solution. There aren't any errors someone could introduce that would cause a problem later. (Don't take that as a challenge folks.)

但它们没有风险，只要您能发现和诊断错误。在我上面的代码中，我相信我已经创建了一个基本上封闭的形式解决方案。没有任何人可能引入的错误会导致以后出现问题。（不要把这当作挑战，伙计们。）

And just to give you some specific guidelines to avoid errors:

只是为了给你一些避免错误的具体指导方针：

• If you start a timer, ensure you kill it later. If you have an Excel runtime error before the timer is killed, it could go on forever and eat your memory. Use the console (Debug.Print) to write a line every time the TimerProc is called. If it keeps ticking away in you console even after your code is done executing, then you have a runaway timer. Quit Excel and come back in when this happens.
• Don't use multiple timers. Use ONE timer to handle multiple timing elements.
• Don't start a new timer without killing an old one.
• Most important: test on your friend's computer to ensure it works across different platforms.

• 如果您启动计时器，请确保稍后将其终止。如果您在计时器终止之前遇到 Excel 运行时错误，它可能会一直持续下去并占用您的内存。每次调用 TimerProc 时，使用控制台 (Debug.Print) 写一行。如果即使在您的代码执行完毕后它仍然在您的控制台中滴答作响，那么您就有了一个失控的计时器。退出 Excel 并在发生这种情况时返回。
• 不要使用多个计时器。使用一个计时器来处理多个计时元素。
• 不要在不杀死旧计时器的情况下启动新计时器。
• 最重要的是：在您朋友的计算机上进行测试以确保它可以跨不同平台运行。

Also, just to be clear: there's no problem using the API timer and editing a cell at the same time.There's nothing about Timers that will preclude your ability to edit anything on the sheet.

另外，要明确一点：使用 API 计时器并同时编辑单元格没有问题。计时器不会妨碍您编辑工作表上的任何内容。

回答by PeterCh

I have also been faced with the fact that Excel crashes while entering a value and found this contribution. Great! My problem was solved as soon I added this line:

我也遇到过这样一个事实，即 Excel 在输入值时崩溃并找到了这个贡献。伟大的！添加此行后，我的问题就解决了：

On Error Resume Next 

to "TimerProc".

到“TimerProc”。

回答by gudule

With the API timer, as soon as I set the time lapse too short, Excel would crash because it had not finished the previous timed task before the next was scheduled. This does not happen with ontime because you set ontime afterfinishing TimerProc.

使用 API 计时器，只要我将时间间隔设置得太短，Excel 就会崩溃，因为它在安排下一个定时任务之前还没有完成上一个定时任务。ontime不会发生这种情况，因为您在完成 TimerProc后设置了 ontime。

Maybe it is possible to kill the timer first thing in Timerproc, and set a new one just before finishing.

也许可以在 Timerproc 中首先杀死计时器，然后在完成之前设置一个新的计时器。

You should be aware that Killtimer actually fails at times, leaving the timer alive and continuing to call the procedure forever. So a machine gun code with feedback control is necessary to be sure it is really dead.

您应该知道 Killtimer 实际上有时会失败，从而使计时器保持活动状态并永远继续调用该过程。所以一个带有反馈控制的机枪代码是必要的，以确保它真的死了。

//pseudo code :
start_kill = timer()
While still_alive= (negative result of killtimer) do
Still_ailve = KillTimer TimerID.
If timer - start_kill > 10 then msgbox "not dead     find a bigger gun" Exit sub
Wend

Of course you need a time out to exit this loop.

当然，您需要一段时间才能退出此循环。