Question

我使用DoEvents在VBA执行中提供1秒的延迟，以正确显示计时器中的倒计时。使用的代码是：

time2 = Now + TimeValue("00:00:01")
Do Until Now >= time2
    DoEvents
Loop

我在另一个Do Until循环中使用了上面的代码。代码显示倒计时，但每次之间的延迟略有不同，特别是嵌套的Do Until循环中显示的部分!!

其余代码是：

Sub btnStart_Click()
 Dim time_2 As Variant
 g_position = True

 If g_position = True Then
    UserForm1.StartUpPosition = 0
    UserForm1.Left = Application.Left + 0.5 * Application.Width +    UserForm1.Width + 72
    UserForm1.Top = Application.Top + (0.5 * Application.Height) - (UserForm1.Height) - 36
 End If

 start = Now
 timeEnd = start + TimeValue("00:00:10")
 g_start = Format(start, "hh:mm:ss")
 g_timeEnd = Format(timeEnd, "hh:mm:ss")
 time_duration = timeEnd - start
 g_time_duration = Format(time_duration, "hh:mm:ss")
 Label1.Visible = True
 time_left.Caption = g_time_duration
 time_left.Visible = True
 btnStart.Visible = False
 time_2 = Now + TimeValue("00:00:01")
 Do Until Now >= time_2
    DoEvents
 Loop
 g_temp = Format(temp, "hh:mm:ss")
 etime = start + TimeValue("00:00:01")
 time_duration = timeEnd - etime
 g_time_duration = Format(time_duration, "hh:mm:ss")
 time_left.Caption = g_time_duration
 time_2 = Now + TimeValue("00:00:01")
 Do Until Now >= time_2
    DoEvents
 Loop
 Call modtimer.time_count(time_duration, etime, timeEnd, g_time_duration)

End Sub

模块代码：

Sub time_count(time_duratn As Variant, etim As Variant, timEnd As Variant, g_time_duratn As Variant)

 temp_end = Format(TimeValue("00:00:00"), "hh:mm:ss")
 temp_alert = Format(TimeValue("00:00:05"), "hh:mm:ss")
 etim = etim + TimeValue("00:00:01")
 time_duratn = timEnd - etim
 g_time_duratn = Format(time_duratn, "hh:mm:ss")
 UserForm1.time_left.Caption = g_time_duratn
 time2 = Now + TimeValue("00:00:01")
 Do Until Now >= time2
    DoEvents
 Loop
 Do Until g_time_duratn = temp_end
    If g_time_duratn = temp_alert Then
        Beep
        MsgBox "Only 5 minutes remaining", vbInformation
    End If
    etim = etim + TimeValue("00:00:01")
    time_duratn = timEnd - etim
    g_time_duratn = Format(time_duratn, "hh:mm:ss")
    UserForm1.time_left.Caption = g_time_duratn
    time2 = Now + TimeValue("00:00:01")
    Do Until Now >= time2
        DoEvents
    Loop
 Loop
 End_Exam
End Sub

为什么倒计时的延迟会有所不同？有人可以帮忙吗？

Answer 1

您获得的时间跨度不同，因为Now，就我测试而言，在Office VBA中为1秒分辨率。因此，Now总是将时间延长到最后一秒。

例如，您开始在00:00:00.500等待，Now将返回#00:00:00#。当时间到达00:00:01.000时，Now将返回#00:00:01#，因此您认为延迟时间为1秒，但只有0.5秒！使用Now你可以“测量”1秒的时间延迟，这可能会在0到1秒之间变化！

作为解决方法，WinAPI GetLocalTime可用于获得1毫秒分辨率的时间戳：

Private Declare Sub GetLocalTime Lib "Kernel32" (lpSystemTime As Any)

Function Now_ms() As Date
    Dim st(0 To 7) As Integer
    GetLocalTime st(0)
    Now_ms = DateSerial(st(0), st(1), st(3)) + TimeSerial(st(4), st(5), st(6)) + st(7) / 1000# * #12:00:01 AM#
End Function

将Now替换为Now_ms，Date与GetSystemTimePreciseAsFileTime数据类型完全兼容，并返回更好的解决时间戳（1ms）。

使用QueryPerformanceCounter（0.1μs）或#{product.name}可以实现更好的分辨率时间戳。

在Word VBA中，DoEvents延迟因计时器而异

1 个答案: