目的:想实现有限循环内的延时自动执行效果。
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
参考资料
https://blog.csdn.net/iamlaosong/article/details/49802327
http://blog.sina.com.cn/s/blog_15b9821340102waqs.html
https://blog.51cto.com/12040328/2130722
msgbox 或 其他倒计时的
加这个延时函数一起使用
4 实现倒计时窗口,倒计时显示且自动关闭