Временные задержки в VBA

Я хотел бы 1-секундную задержку в моем коде. Ниже приведен код, который я пытаюсь сделать эту задержку. Я думаю, что он опрашивает дату и время от операционной системы и ждет, пока время не совпадет. У меня проблема с задержкой. Я думаю, что он не опрашивает время, когда он соответствует времени ожидания, и он просто сидит там и замерзает. Он зависает только около 5% времени, когда я запускаю код. Мне было интересно О применении.Подождите, и если есть способ проверить, больше ли опрошенное время чем время ожидания.

   newHour = Hour(Now())
   newMinute = Minute(Now())
   newSecond = Second(Now()) + 1
   waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime
14
pause timedelay timer vba wait

11 ответов

Я использую эту небольшую функцию для 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
19

Если вы находитесь в Excel VBA, вы можете использовать следующее.

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

(строка времени должна выглядеть как H:MM: SS.)

36

вы можете скопировать это в модуле:

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

Do while timer < sngsec
DoEvents
Loop

End sub

и всякий раз, когда вы хотите применить паузы записи:

Call WaitFor(1)

надеюсь, это поможет!

11

вы пытались использовать сон?

вот пример здесь (скопировал ниже):

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

обратите внимание, что это может заморозить приложение на выбранное количество времени.

6

другой вариант ответа Стива Мэллори, мне особенно нужен был 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
2

на таймер функция также применяется к 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
2

Access всегда может использовать процедуру Excel, пока проект имеет Microsoft Excel XX.X Объект справочник включены:

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

ваш код создает только время без даты. Если ваше предположение верно, что при запуске приложения.подождите время на самом деле уже достигнуто, что время будет ждать 24 часа ровно. Я также немного беспокоюсь о вызове now () несколько раз (может быть по-другому?) Я бы изменил код на 

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

я использовал ответ Стива Мэллори, но я боюсь, что таймер никогда или, по крайней мере, иногда не идет на 86400 или 0 (ноль) sharp (MS Access 2013). Поэтому я изменил код. Я изменил условие полуночи на " если таймер >= 86399, то" и добавил разрыв цикла "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
1

на Windows таймер возвращает сотые доли секунды... Большинство людей просто используют секунды, потому что на платформе Macintosh таймер возвращает целые числа.

0

с должными кредитами и благодаря Стиву Маллрою.

У меня были полночные проблемы в 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
0