VBA 中的时序延迟

Question

我希望我的代码延迟 1 秒。下面是我试图延迟的代码。我认为它会轮询操作系统的日期和时间并等待时间匹配。我对延迟有疑问。我认为它不会轮询与等待时间匹配的时间，它只是坐在那里并冻结。在我运行代码时，它只冻结了大约 5% 的时间。我想知道 Application.Wait 以及是否有办法检查轮询时间是否大于等待时间。

   newHour = Hour(Now())
   newMinute = Minute(Now())
   newSecond = Second(Now()) + 1
   waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime

Answer 1

计时器功能还适用于 Access 2007、Access 2010、Access 2013、Access 2016、Access 2007 Developer、Access 2010 Developer、Access 2013 Developer。插入此代码以暂停一定秒数的时间

T0 = Timer
Do
    Delay = Timer - T0
Loop Until Delay = 1 'Change this value to pause time in second

Answer 2

接受的答案中对午夜的处理是错误的。它测试 Timer = 0，这几乎永远不会发生。它应该测试 Timer <开始。另一个答案尝试更正 Timer >= 86399，但该测试在速度较慢的计算机上也可能会失败。

下面的代码正确处理午夜（比Timer 复杂一点）。它也是一个子函数，而不是一个函数，因为它不返回值，并且变量是单变量，因为它们不需要变体。

Public Sub pPause(nPauseTime As Single)

' Pause for nPauseTime seconds.

Dim nStartTime As Single, nEndTime As Single, _
    nNowTime As Single, nElapsedTime As Single

nStartTime = Timer()
nEndTime = nStartTime + nPauseTime

Do While nNowTime < nEndTime
    nNowTime = Timer()
    If (nNowTime < nStartTime) Then     ' Crossed midnight.
        nEndTime = nEndTime - nElapsedTime
        nStartTime = 0
      End If
    nElapsedTime = nNowTime - nStartTime
    DoEvents    ' Yield to other processes.
  Loop

End Sub

Answer 3

我使用了 Steve Mallory 的答案，但我担心计时器永远不会或至少有时不会达到 86400 或 0（零）锐（MS Access 2013）。所以我修改了代码。我将午夜条件更改为“If Timer >= 86399 then”
并添加循环“Exit Do”的中断，如下所示：

Public Function Pause(NumberOfSeconds As Variant)
    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer >= 86399
            ' Crossing midnight
            ' PauseTime = PauseTime - Elapsed
            ' Start = 0
            ' Elapsed = 0
            Exit Do
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function

Answer 4

在 Windows 上，计时器返回百分之一秒...大多数人只使用秒，因为在 Macintosh 平台上，计时器返回整数。

Answer 5

感谢 Steve Mallroy 的应有贡献。

我在 Word 中遇到了午夜问题，下面的代码对我有用

Public Function Pause(NumberOfSeconds As Variant)
 '   On Error GoTo Error_GoTo

    Dim PauseTime, Start
    Dim objWord As Word.Document

    'PauseTime = 10 ' Set duration in seconds
    PauseTime = NumberOfSeconds
    Start = Timer ' Set start time.

    If Start + PauseTime > 86399 Then 'playing safe hence 86399

    Start = 0

    Do While Timer > 1
        DoEvents ' Yield to other processes.
    Loop

    End If

    Do While Timer < Start + PauseTime
        DoEvents ' Yield to other processes.
    Loop

End Function

Answer 6

对于 MS Access：启动带有 Me.TimerInterval 设置和 Form_Timer 事件处理程序的隐藏表单。将要延迟的代码放入 Form_Timer 例程中 - 每次执行后退出例程。

例如：

Private Sub Form_Load()
    Me.TimerInterval = 30000 ' 30 sec
End Sub

Private Sub Form_Timer()

    Dim lngTimerInterval  As Long: lngTimerInterval = Me.TimerInterval

    Me.TimerInterval = 0

    '<Your Code goes here>

    Me.TimerInterval = lngTimerInterval
End Sub

“您的代码在此处”将在表单打开后 30 秒执行，并在每次后续执行后 30 秒执行。

完成后关闭隐藏表单。

Answer 7

如果您使用的是 Excel VBA，则可以使用以下命令。

Application.Wait(Now + TimeValue("0:00:01"))

（时间字符串应类似于 H:MM:SS。）

Answer 8

我在 VBA 中使用这个小函数。

Public Function Pause(NumberOfSeconds As Variant)
    On Error GoTo Error_GoTo

    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant

    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer = 0 Then
            ' Crossing midnight
            PauseTime = PauseTime - Elapsed
            Start = 0
            Elapsed = 0
        End If
        DoEvents
    Loop

Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function

Answer 9

您可以将其复制到模块中：

Sub WaitFor(NumOfSeconds As Long)
Dim SngSec as Long
SngSec=Timer + NumOfSeconds

Do while timer < sngsec
DoEvents
Loop

End sub

并且每当您想要应用暂停时写：

Call WaitFor(1)

我希望有帮助！

Answer 10

您尝试过使用睡眠吗？

有一个示例此处（复制如下）：

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Activate()    

frmSplash.Show
DoEvents
Sleep 1000
Unload Me
frmProfiles.Show

End Sub

请注意，它可能会冻结申请所选的时间。

Answer 11

只要项目具有 Microsoft Excel XX.X 对象，Access 始终可以使用 Excel 过程 包含参考：

Call Excel.Application.Wait(DateAdd("s",10,Now()))

Answer 12

您的代码仅创建没有日期的时间。如果您的假设是正确的，那么当它运行 application.wait 的时间实际上已经达到该时间时，它将恰好等待 24 小时。我还担心多次调用 now() （可能不同？）我会将代码更改为

 application.wait DateAdd("s", 1, Now)

Answer 13

Steve Mallory 回答的另一个变体是，我特别需要 excel 在等待时跑掉并做一些事情，而 1 秒太长了。

'Wait for the specified number of milliseconds while processing the message pump
'This allows excel to catch up on background operations
Sub WaitFor(milliseconds As Single)

    Dim finish As Single
    Dim days As Integer

    'Timer is the number of seconds since midnight (as a single)
    finish = Timer + (milliseconds / 1000)
    'If we are near midnight (or specify a very long time!) then finish could be
    'greater than the maximum possible value of timer. Bring it down to sensible
    'levels and count the number of midnights
    While finish >= 86400
        finish = finish - 86400
        days = days + 1
    Wend

    Dim lastTime As Single
    lastTime = Timer

    'When we are on the correct day and the time is after the finish we can leave
    While days >= 0 And Timer < finish
        DoEvents
        'Timer should be always increasing except when it rolls over midnight
        'if it shrunk we've gone back in time or we're on a new day
        If Timer < lastTime Then
            days = days - 1
        End If
        lastTime = Timer
    Wend

End Sub