VBA延时的三个方法--以及声明之后，使用sleep报错的解决方案（declare ptrsaft）

候鸟360 2023-11-10 发布于浙江

展开全文

查阅相关资料，获取较为可行的三个方法为：

1、一般延时（计时单位为秒级，1代表1s，下面两种方法皆是毫秒级，1000代表1s）

一个应用接口需要限制运行速度，需要在循环中加个延时函数，这个延时不需要多么精确，要求有个几秒延时，网上用的比较多的就是用Timer函数编写，Timer是VBA自带的函数，用起来比较方便，一般程序如下：'延时程序

Sub delay(T As Single)
    Dim time1 As Single
    time1 = Timer
    Do
        DoEvents
    Loop While Timer - time1 < T
    Debug.Print ("运行结束，总计耗时为：" & Timer - time1 & "s")
End Sub
Sub ce_time()
delay (1.5)
End Sub

效果图如下：(图一图二一样的，不过图一没有那么讲究换行，代码规范= =||，另计时方式不同~)

Sub delay(T As Single)
    Dim time1 As Single
    time1 = Timer
    Do
        DoEvents
    Loop While Timer - time1 < T
End Sub
Sub ce_time()
    Dim d As Date
    d = Time()
    delay (2)
    '切换输出计时方式
    Debug.Print ("运行结束，总计耗时为：" & DateDiff("s", d, Time()) & "s")
End Sub

2、精确延时--sleep

精确延时可以使用sleep函数，sleep函数是Windows API函数，使用前必须先声明，然后使用，例如：

64位系统报错运行代码：（32位系统则为正确代码）

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ce_time()
    Dim d As Date
    d = Time()
    Sleep 3000 '延时3秒
    Debug.Print ("运行结束，总计耗时" & DateDiff("s", d, Time()) & "s")
End Sub

但是实际运行中，我报错了~

报错截图如下：

后找寻结果为：在Declare 后面加上 PtrSafe 即可

即：Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

至于原因，大概是这样的，详情可以转到另外一个文章：

https://blog.csdn.net/STR_Liang/article/details/104628452

在 VBA 7 中，必须更新现有 Windows 应用程序编程接口 (API) 语句（Declare 语句）才能处理 64 位版本。另外，还必须更新这些语句使用的用户定义类型中的地址指针和显示窗口句柄。本文将详细讨论这一点以及 32 位和 64 位版本的 Office 2010 之间的兼容性问题，并提供建议的解决方案。

64位系统正确运行代码：

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ce_time()
    Dim d As Date
    d = Time()
    Sleep 3000 '延时3秒
    Debug.Print ("运行结束，总计耗时" & DateDiff("s", d, Time()) & "s")
End Sub

运行截图如下：

sleep函数延时是毫秒级的，精确度比较高，但它在延时时会将程序挂起，使操作系统暂时无法响应用户操作，所以在长延时的时候不适合使用它。

3、精确延时--timeGetTime（这里和上面的sleep一样需要声明，如果报错，同样的加一个PtrSafe即可）

更好的办法是使用timeGetTime函数，timeGetTime函数返回的是开机到现在的毫秒数，可以支持1毫秒的间隔时间，而且永远增加，不存在回头的问题。当然不是永远不回头，毕竟Long型变量（双字，4字节）也是有取值范围的，这个值在0到2^32之间。大约49.71天。

同sleep函数一样，timeGetTime函数是Windows API函数，使用前必须先声明，即：

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

延时函数和上面的一样，只是将Timer函数换成timeGetTime：

'精确延时程序

Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
Sub delay(T As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
        DoEvents
    Loop While timeGetTime - time1 < T
End Sub
Sub ce_time()
    Dim d As Date
    d = Time()
    Call delay(1000) '调用函数 可以使用call，也可以不使用
    Debug.Print ("运行结束，总计耗时为：" & DateDiff("s", d, Time()) & "s")
End Sub