VBA，实现延时自动执行的各种方法

最新推荐文章于 2024-06-26 16:32:55 发布

奔跑的犀牛先生

最新推荐文章于 2024-06-26 16:32:55 发布

阅读量1.7w

点赞数 5

本文链接：https://blog.csdn.net/xuemanqianshan/article/details/104873772

版权

目的：想实现有限循环内的延时自动执行效果。

1 前置知识

1.1 do events

DoEvents( ) 转让控制权，以便让操作系统处理其它的事件。

DoEvents 函数会返回一个 Integer，以代表 Visual Basic 独立版本中打开的窗体数目，例如，Visual Basic，专业版，在其它的应用程序中，DoEvents 返回 0。
DoEvents 会将控制权传给操作系统。当操作系统处理完队列中的事件，并且在 SendKeys 队列中的所有键也都已送出之后，返回控制权。
DoEvents 对于简化诸如允许用户取消一个已启动的过程 — 例如搜寻一个文件 — 特别有用。对于长时间过程，放弃控制权最好使用定时器或通过委派任务给 ActiveX EXE 部件来完成。以后，任务还是完全独立于应用程序，多任务及时间片由操作系统来处理。
小心确保以 DoEvents 放弃控制权的过程，在第一次 DoEvents 返回之前，不能再次被其他部分的代码调用；否则会产生不可预料的结果。此外，如果其它的应用程序可能会和本过程以不可预知的方式进行交互操作，那么也不要使用 DoEvents，因为此时不能放弃控制权。

1.2 timer() 计时器

VBA自带计时器 timer()
单位是秒
数据存储类型 typename(timer())=single

1.3 sleep 休眠（需声明新库 Lib "kernel32"）

sleep 是让程序休眠一段时间
windows API
需要加载新的库 Lib "kernel32"
需要加载新的库，Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
sleep 2000

1.4 timeGettime （需声明新库 Lib "winmm.dll" ）

windows API
需要加载新的库 Lib "winmm.dll"
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
time1 = timeGetTime

2 延迟的方法1：使用timer() + doevents ，单位：秒

下面是写了一个 timer()的 delay函数
局限性 timer() 的原理是从每日0点开始累计秒数，也就是过每天24:00:00 时会重新计时，不会一直累加
所以要加一个判断， If time2 < 0 Then time2 = time2 + 86400 ，这个是为了防止因为timer不一直累加，而判断永远为负数
单位：秒

Sub test_print1()
    For i = 1 To 10
       Debug.Print i
       delay30 (2)
    Next
End Sub

Sub delay30(t As Single)
    Dim time1 As Single
    time1 = Timer
    Do
        DoEvents
        time2 = Timer - time1
        If time2 < 0 Then time2 = time2 + 86400
    Loop While time2 < t
    
End Sub

也可以直接写

Sub test_print11()
    For i = 1 To 10
       Debug.Print i
       time1 = Timer()
       Do
          DoEvents
          time2 = Timer() - time1
          If time2 < 0 Then time2 = time2 + 86400
       Loop While time2 < 2
    Next
End Sub

3 延迟的方法2:sleep ：会转圈loading，单位毫秒

需要加载新的库，Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
sleep 毫秒数
另外 sleep需要配合 doevents用
局限性：坏处是让系统等待，比如转圈loading

3.1 直接使用sleep

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

Sub test_t1()
For i = 1 To 10
   Debug.Print i
   Sleep 2000
Next
End Sub

3.2 用sleep写的 delay 过程或函数，调用

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

Sub test_t2()
For i = 1 To 10
   Debug.Print i
   delay_t2 (3000)
Next
End Sub


Function delay_t2(t)
   Sleep (t)
End Function

3.3 sleep + doevents 会缓解些，但是还是会转圈等待

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

Sub test_t2()
For i = 1 To 10
   Debug.Print i
   delay_t2 (3000)
Next
End Sub


Function delay_t2(t)
   Sleep (t)
   DoEvents
End Function

4 延迟的方法3： timeGettime +doevents ，单位毫秒

需要加载新的库 Lib "winmm.dll"
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
time1 = timeGetTime

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

Sub test_print1()
    For i = 1 To 10
       Debug.Print i
       delay1 (2000)
    Next
End Sub


Sub delay1(t As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
        DoEvents
     Loop While timeGetTime - time1 < t
End Sub

尝试了下，如果注掉 doevents 就会卡顿

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

Sub test_print1()
    For i = 1 To 10
       Debug.Print i
       delay1 (2000)
    Next
End Sub

Sub delay1(t As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
'        DoEvents      '如果不加doevents 就会像sleep一样，总卡着等待
     Loop While timeGetTime - time1 < t
End Sub

5 Application.wait 方法也可以

5.1 applcation.wait 也可以达到延时效果，但是也是要卡顿

注意 application.wait () 后面跟的时间不能是时间值/段，得是时间点，所以得是 now+timevalue()


Sub test_print1()
    For i = 1 To 10
       Debug.Print i
       Application.Wait (Now + TimeValue("00:00:03"))
       DoEvents
    Next
End Sub

5.2 尝试用 application.wait + doevents 也是可以的

直接写 doevents 好像不行
但是我用了 do while 里 doevents 发现加不加 application.wait 都可以

Sub test_print1()
    For i = 1 To 10
       Debug.Print i
       time1 = Now()     '中间变量固定下当时的时间
       Do
           DoEvents
       Loop While Now() < time1 + TimeValue("00:00:03")
'       Application.Wait time1 + TimeValue("00:00:03")
    Next
End Sub

6 Application.ontime 方法?? --还没写完



Sub test_print12()
    For i = 1 To 10
       Debug.Print i
    Next
End Sub



Sub test_print13()
    For i = 1 To 10
       Application.OnTime Now() + TimeValue("00:00:03"), procedure:="t12"
    Next
End Sub


Sub t12()
    Debug.Print i
    i = i + 1
End Sub

7 我发现单独用 doevents+时间判断也可以


Sub test_print1()
    For i = 1 To 10
       Debug.Print i
       time1 = Now()     '中间变量固定下当时的时间
       Do
           DoEvents
       Loop While Now() < time1 + TimeValue("00:00:02")
    Next
End Sub

也可以写出只用 doevents +时间的专门的delay() 函数或过程

Sub test_print11()
    For i = 1 To 10
      Debug.Print i
      test_delay5 (3)
    Next
End Sub


Sub test_delay5(t)
   time1 = Now()
   Do
      DoEvents
   Loop While Now() < time1 + TimeValue("00:00:" & t)  '只允许设定延迟秒数
End Sub