Visual Basic for Applications/跨越午夜的延迟

摘要

此 VBA 模块会延迟指定的秒数。它可以在任何可以运行 VBA 的 MS Office 应用程序中工作。以下几点值得注意

• 大多数延迟程序在午夜时遇到问题，因为 Timer 函数会重置，因此依赖于跨越该时间的两个值的差值的代码将出错，并可能导致失败。此过程通过补偿经过的天数来避免此类问题。因此，它将被发现在计时和时钟应用程序中很有用，如果不是用于测量时间，至少可以用于决定何时更新显示。例如；从午夜前十秒 (时钟计数 86390) 运行 20 秒的延迟到午夜后十秒 (假设时钟计数 86410) 将在午夜重置，并且永远不会达到所需的结束值。该问题通过在每次进行日期转换时将 86400 (一天中的秒数) 的一个计数添加到步进值来解决。
• 该过程的预期分辨率约为 10-16 毫秒，与系统计时器的分辨率一致。也许有趣的是要注意 GetTickCount API 虽然可以接受毫秒参数，但仍然限于系统计时器的相同 10-16 毫秒分辨率。
• 该过程参数可以采用秒的整数和小数，只要记住有关分辨率的注释。

代码

将以下 VBA 代码复制到 Excel、Word 或任何其他支持 VBA 的 Office 应用程序中的标准模块中。

Option Explicit

Sub testDelay()
    'tests delay procedure
    
    MsgBox DelaySecs(1.1)    'seconds

End Sub

Function DelaySecs(nSecs As Single) As Boolean
    'Delays for nSecs SECONDS.
    'Avoids midnight reset problem.
    'Typical resolution 10-16mS.
    
    Dim StartDate As Date
    Dim StartTime As Single
    Dim TimeNow As Single
    Dim Lapsed As Single
    
    'get launch date and current timer
    StartTime = Timer
    StartDate = Date
    
    'then loop until lapse of parameter time
    Do
        DoEvents 'allow form updates and breaks
        '86400 seconds per new day
        TimeNow = 86400 * (Date - StartDate) + Timer
        Lapsed = TimeNow - StartTime
    Loop Until Lapsed >= nSecs
    'MsgBox Lapsed
    
    DelaySecs = True
    
End Function

另请参见

• 等待函数 - Chip Pearson: 考虑了其他几种延迟方法。