Сроки задержки в VBA

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

   newHour = Hour(Now())
   newMinute = Minute(Now())
   newSecond = Second(Now()) + 1
   waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime
Источник

13 ответов

Решение

Я использую эту маленькую функцию для 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
Источник

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

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

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

Источник

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

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

Do while timer < sngsec
DoEvents
Loop

End sub

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

Call WaitFor(1)

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

Источник

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

Вот пример ЗДЕСЬ (скопировано ниже):

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

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

Источник

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

Call Excel.Application.Wait(DateAdd("s",10,Now()))
Источник

Функция таймера также применяется к 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
Источник

Еще один вариант ответа Стива Мэллориса: мне особенно нужно было, чтобы 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
Источник

Я использовал ответ Стива Мэллори, но я боюсь, что таймер никогда или по крайней мере иногда не идет к 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
Источник

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

 application.wait DateAdd("s", 1, Now)
Источник

Обработка полуночи в принятом ответе неверна. Он проверяет на Timer = 0, чего почти никогда не произойдет. Вместо этого он должен проверить. Другой ответ попытался исправить 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
Источник

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

У меня были проблемы с полночью в 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
Источник

Для 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 секунд после каждого последующего выполнения.

Закройте скрытую форму, когда закончите.

Источник

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

Источник
Другие вопросы по тегам