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

如果您在 Excel VBA 中，您可以使用以下内容。

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

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

Answer 2

我将这个小函数用于 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 3

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

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

Do while timer < sngsec
DoEvents
Loop

End sub

以及每当您想应用暂停写入时：

Call WaitFor(1)

希望对你有帮助！

Answer 4

你试过使用睡眠吗？

有一个例子HERE（复制如下）：

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 5

只要项目有 Microsoft Excel XX.X 对象reference included，Access 就可以始终使用 Excel 过程：

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

Answer 6

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

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

Answer 7

Steve Mallorys 回答的另一种变体，我特别需要 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

Answer 8

定时器功能同样适用于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 9

我使用了 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 10

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

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

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 11

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

Answer 12

感谢 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 13

对于 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 秒执行。

完成后关闭隐藏表单。