0

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

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

我在另一个执行直到循环中使用了上面的代码。代码显示倒计时，但每次之间的延迟略有不同，尤其是嵌套执行直到循环中显示的部分！

其余的代码是：

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

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

4

1 回答 1

2

您得到不同的时间跨度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 秒之间变化！

作为解决方法，WinAPIGetLocalTime可用于获取 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并返回更好的分辨率时间戳（1ms）。

GetSystemTimePreciseAsFileTime使用(0.1μs) 或可以实现更好的分辨率时间戳QueryPerformanceCounter。

于 2018-04-22T08:43:28.790 回答