在 Excel VBA 中创建毫秒循环

Question

由于我刚刚发现 Excel 宏，我想尝试模拟移动对象。我想在项目的每个“帧”中运行一些循环代码。我可以使用以下代码在 Excel VBA 中进行无限循环：

Do While True:
    'code
Loop

但是，这会使 Excel 崩溃。有没有办法让每十毫秒左右运行一次无限循环，像这样：

Dim timer as Timer
If timer = 10 Then
    'code
    timer = 0
End If

编辑：您的答案非常好，但不完全是我想要的。我希望能够同时运行其他代码；有点像 Javascript 的

setInterval(function(){}, 200);

可以同时运行多个功能。

Answer 1

您可以使用 API 调用和睡眠。

把它放在你模块的顶部：

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

然后你可以在这样的过程中调用它：

Do While True:

Sleep 10    'wait 0.01 seconds

Loop

如果代码在 64 位操作系统中，则需要使用 PtrSafe。见https://support.microsoft.com/en-us/help/983043/compile-error-the-code-in-this-project-must-be-updated-for-use-on-64

Answer 2

您的原始方法使 Excel 崩溃，因为它正在创建一个没有退出条件的无限循环。

第二种方法不起作用，因为您的系统时钟时间（由Timer 给出）永远不会是10，如果您在即时窗口中使用debug.Print(Timer)，您将看到它的值。

这里是一些注释代码，用于根据计时器执行一些操作。请确保您保留退出while 循环的runtime 条件，无限循环是魔鬼，实际上您应该在这里的某个地方有一些其他退出代码！

Sub timeloop()
    Dim start As Double: start = Timer     ' Use Timer to get current time
    Dim t As Double: t = start             ' Set current time "t" equal to start
    Dim interval As Double: interval = 1   ' Interval for loop update (seconds)
    Dim nIntervals As Long: nIntervals = 0 ' Number of intervals passed

    ' Use this While loop to avoid an infinite duration! Only runs for "runtime" seconds
    Dim runtime As Double: runtime = 10
    Do While t < start + runtime
        ' Check if a full interval has passed
        If (t - start) / interval > nIntervals Then
            nIntervals = nIntervals + 1
            ' Do stuff here ---
            Debug.Print (t)
            ' -----------------
        End If
        t = Timer ' Update current time
    Loop
End Sub