vba - VBA 中的时序延迟

Question

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

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

score 38 · Accepted Answer

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

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

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

score 25 · Accepted Answer

我将这个小功能用于 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

score 13 · Accepted Answer

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

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

Do while timer < sngsec
DoEvents
Loop

End sub

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

Call WaitFor(1)

我希望这会有所帮助！

score 7 · Accepted Answer

您是否尝试过使用睡眠？

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

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

请注意，它可能会在选定的时间内冻结应用程序。

score 3 · Accepted Answer

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

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

score 1 · Accepted Answer

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

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

score 1 · Accepted Answer

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

score 1 · Accepted Answer

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

score 0 · Accepted Answer

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

score 0 · Accepted Answer

在接受的答案中处理午夜是错误的。它测试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

score -1 · Accepted Answer

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

score -1 · Accepted Answer

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

score -1 · Accepted Answer

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

完成后关闭隐藏的表单。

vba - VBA 中的时序延迟

13 回答 13

Related

Reference