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: 考慮了其他幾種延遲方法。