Как сделать паузу на определенное количество времени? (Excel / VBA)

Question

У меня есть лист Excel, в котором есть следующий макрос. Я хотел бы повторять это каждую секунду, но опасно, если я смогу найти функцию для этого. Разве это не возможно?

Sub Macro1()
'
' Macro1 Macro
'
Do
    Calculate
    'Here I want to wait for one second

Loop
End Sub

Answer 1

Используйте Метод ожидания :

Application.Wait Now + #0:00:01#

или (для Excel 2010 и более поздних версий):

Application.Wait Now + #12:00:01 AM#

Answer 2

Добавьте это к вашему модулю

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

Или, для 64-битных систем используйте:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Назовите это в вашем макросе так:

Sub Macro1()
'
' Macro1 Macro
'
Do
    Calculate
    Sleep (1000) ' delay 1 second

Loop
End Sub

Answer 3

вместо использования:

Application.Wait(Now + #0:00:01#)

Я предпочитаю:

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

потому что потом читать намного легче.

Answer 4

это работает безупречно для меня. вставьте любой код до или после цикла «до». В вашем случае поместите 5 строк (time1 = & time2 = & do do) в конец цикла do

sub whatever()
Dim time1, time2

time1 = Now
time2 = Now + TimeValue("0:00:01")
    Do Until time1 >= time2
        DoEvents
        time1 = Now()
    Loop

End sub

Answer 5

Объявление для Sleep в kernel32.dll не будет работать в 64-битном Excel. Это было бы немного более общим:

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Answer 6

Просто очищенная версия кода clemo - работает в Access, у которого нет функции Application.Wait.

Public Sub Pause(sngSecs As Single)
    Dim sngEnd As Single
    sngEnd = Timer + sngSecs
    While Timer < sngEnd
        DoEvents
    Wend
End Sub

Public Sub TestPause()
    Pause 1
    MsgBox "done"
End Sub

Answer 7

Application.Wait Second(Now) + 1

Answer 8

В большинстве представленных решений используется Application.Wait, который не учитывает время (миллисекунды), уже прошедшее с момента начала подсчета секунды, поэтому имеет внутреннюю неточность до 1 секунды .

Подход с использованием таймера является наилучшим решением , но вы должны принять во внимание сброс в полночь, поэтому вот очень точный метод Sleep с использованием таймера:

'You can use integer (1 for 1 second) or single (1.5 for 1 and a half second)
Public Sub Sleep(vSeconds As Variant)
    Dim t0 As Single, t1 As Single
    t0 = Timer
    Do
        t1 = Timer
        If t1 < t0 Then t1 = t1 + 86400 'Timer overflows at midnight
        DoEvents    'optional, to avoid excel freeze while sleeping
    Loop Until t1 - t0 >= vSeconds
End Sub

ИСПОЛЬЗУЙТЕ ЭТО ДЛЯ ТЕСТИРОВАНИЯ ЛЮБОЙ ФУНКЦИИ СНА: (откройте отладку. Немедленное окно: CTRL + G)

Sub testSleep()
    t0 = Timer
    Debug.Print "Time before sleep:"; t0   'Timer format is in seconds since midnight

    Sleep (1.5)

    Debug.Print "Time after sleep:"; Timer
    Debug.Print "Slept for:"; Timer - t0; "seconds"

End Sub

Answer 9

Вот альтернатива для сна:

Sub TDelay(delay As Long)
Dim n As Long
For n = 1 To delay
DoEvents
Next n
End Sub

В следующем коде я заставляю мигать эффект «свечения» на кнопке прокрутки, чтобы направлять пользователей к ней, если у них «возникают проблемы», использование «sleep 1000» в цикле не привело к видимому миганию, но цикл отлично работает.

Sub SpinFocus()
Dim i As Long
For i = 1 To 3   '3 blinks
Worksheets(2).Shapes("SpinGlow").ZOrder (msoBringToFront)
TDelay (10000)   'this makes the glow stay lit longer than not, looks nice.
Worksheets(2).Shapes("SpinGlow").ZOrder (msoSendBackward)
TDelay (100)
Next i
End Sub

Answer 10

Function Delay(ByVal T As Integer)
    'Function can be used to introduce a delay of up to 99 seconds
    'Call Function ex:  Delay 2 {introduces a 2 second delay before execution of code resumes}
        strT = Mid((100 + T), 2, 2)
            strSecsDelay = "00:00:" & strT
    Application.Wait (Now + TimeValue(strSecsDelay))
End Function