如何暂停特定的时间? (Excel/VBA)

我有一个 Excel 工作表,它具有以下宏。我希望每秒循环一次,但是如果我能找到这样做的函数,就有危险了。有可能吗?

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


Loop
End Sub
842592 次浏览

Use the Wait method:

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

or (for Excel 2010 and later):

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

Add this to your module

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

Or, for 64-bit systems use:

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

Call it in your macro like so:

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


Loop
End Sub

Try this :

Threading.thread.sleep(1000)

this works flawlessly for me. insert any code before or after the "do until" loop. In your case, put the 5 lines (time1= & time2= & "do until" loop) at the end inside your do loop

sub whatever()
Dim time1, time2


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


End sub

The declaration for Sleep in kernel32.dll won't work in 64-bit Excel. This would be a little more general:

#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

instead of using:

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

i prefer:

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

because it is a lot easier to read afterwards.

Application.Wait Second(Now) + 1

i had this made to answer the problem:

Sub goTIMER(NumOfSeconds As Long) 'in (seconds) as:  call gotimer (1)  'seconds
Application.Wait now + NumOfSeconds / 86400#
'Application.Wait (Now + TimeValue("0:00:05"))  'other
Application.EnableEvents = True       'EVENTS
End Sub
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

Just a cleaned up version of clemo's code - works in Access, which doesn't have the Application.Wait function.

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

I usually use the Timer function to pause the application. Insert this code to yours

T0 = Timer
Do
Delay = Timer - T0
Loop Until Delay >= 1 'Change this value to pause time for a certain amount of seconds

Here is an alternative to sleep:

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

In the following code I make a "glow" effect blink on a spin button to direct users to it if they are "having trouble", using "sleep 1000" in the loop resulted in no visible blinking, but the loop is working great.

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

Most of the presented solutions use Application.Wait, which does not take in account the time (miliseconds) already elapsed since the currend second count started, so they have an intrinsic imprecision of up to 1 second.

The Timer approach is the best solution, but you have to take in account the reset at midnight, so here is a very precise Sleep method using Timer:

'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

USE THIS TO TEST ANY SLEEP FUNCTION: (open debug Immediate window: 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

Wait and Sleep functions lock Excel and you can't do anything else until the delay finishes. On the other hand Loop delays doesn't give you an exact time to wait.

So, I've made this workaround joining a little bit of both concepts. It loops until the time is the time you want.

Private Sub Waste10Sec()
target = (Now + TimeValue("0:00:10"))
Do
DoEvents 'keeps excel running other stuff
Loop Until Now >= target
End Sub

You just need to call Waste10Sec where you need the delay

You can use Application.wait now + timevalue("00:00:01") or Application.wait now + timeserial(0,0,1)

Ultimate Guide to Pausing VBA Execution

Background Information and Explanation

All Microsoft Office applications run VBA code in the same thread as the main user interface. This means, as long as the VBA code doesn't call DoEvents, code execution freezes the entire application (It will show as "not responding" in Task-Manager!). This includes calls to the Sleep API function. Once Sleep is called, there is no way of recovering from this state without waiting for the time to pass or force quitting the Application and restarting it.

The Excel-specific Application.Wait also suffers from this issue, except that the app will not show as not responding in Task Manager in this case. It will still be just as unresponsive to the user.

A way to circumvent this problem is calling DoEvents in a loop, as other people have already pointed out. However, this comes with another issue. Because the application will try to execute VBA code as fast as possible, DoEvents is called at the maximum achievable rate essentially saturating the CPU completely on that single thread, leading to high, unnecessary CPU and power usage and potentially slowing down other more important tasks in the UI.

This is why the best way of getting VBA to pause execution is a combination of both methods, using DoEvents to stay responsive and Sleep to avoid maximum CPU usage. An implementation of this is presented in the following.


Universal Solution

The following code implements a WaitSeconds Sub that will pause execution for a given amount of seconds while avoiding all of the above-mentioned issues. It can be used like this:

Sub UsageExample()
WaitSeconds 3.5
End Sub

This will pause the macro for 3.5 seconds, without freezing the application or causing excessive CPU usage. For this to work, just copy the following code to the top of any standard code module.

#If Mac Then
#If VBA7 Then
Private Declare PtrSafe Sub USleep Lib "/usr/lib/libc.dylib" Alias "usleep" (ByVal dwMicroseconds As Long)
#Else
Private Declare Sub USleep Lib "/usr/lib/libc.dylib" Alias "usleep" (ByVal dwMicroseconds As Long)
#End If
#Else 'Windows
#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
#End If
#If Mac Then
'Sub providing a Sleep API consistent with Windows on Mac (argument in ms)
'Authors: Cristian Buse,      https://stackoverflow.com/a/71176040/12287457
'         Guido Witt-Dörring, https://stackoverflow.com/a/74262120/12287457
Public Sub Sleep(ByVal dwMilliseconds As Long)
Do While dwMilliseconds And &H80000000
USleep &HFFFFFED8
If dwMilliseconds < (&H418937 Or &H80000000) Then
dwMilliseconds = &H7FBE76C9 + (dwMilliseconds - &H80000000)
Else
dwMilliseconds = dwMilliseconds - &H418937
End If
Loop
Do While dwMilliseconds > &H418937
USleep &HFFFFFED8: dwMilliseconds = dwMilliseconds - &H418937
Loop
If dwMilliseconds > &H20C49B Then
USleep (dwMilliseconds * 500& Or &H80000000) * 2&
Else
USleep dwMilliseconds * 1000&
End If
End Sub
#End If


'Sub pausing code execution without freezing the app or causing high CPU usage
'Author: Guido Witt-Dörring, https://stackoverflow.com/a/74387976/12287457
Public Sub WaitSeconds(ByVal seconds As Single)
Dim currTime As Single, endTime As Single, cacheTime As Single
currTime = Timer(): endTime = currTime + seconds: cacheTime = currTime
Do While currTime < endTime
Sleep 15: DoEvents: currTime = Timer()
'The following is necessary because the Timer() function resets at 00:00
If currTime < cacheTime Then endTime = endTime - 86400! 'seconds per day
cacheTime = currTime
Loop
End Sub

[1] More information on the cross-platform Sleep included in the above code can be found here and here.

If application freezing is not an issue, e.g. for very short delays or if user interaction is undesired, the best solution is to call Sleep directly. This is why, in the above solution, it is also declared as Public. Note that Sleep takes its argument as milliseconds.

'Does freeze application
Sub UsageExample()
Sleep 3.5 * 1000
End Sub

Important Notes:

  1. If you want to use this code inside of a class module and you don't want to declare the Sleep sub in an additional standard module, you can use the above code but you have to change the declaration for all of the Sleep subs to Private because it is impossible to import API functions as Public inside a class module.

  2. The time precision of the Timer() function used in this solution is better on Windows, however, the claim in the documentation, that resolution on Mac is one second, is wrong. Even on Mac, the resolution is better than 0.1 seconds. Still, you shouldn't expect a resolution much better than ~0.1 seconds from this solution! WaitSeconds 1 will wait around 1.015 ± 0.02 seconds on Windows.

  3. If you plan on using this to pause your code for long periods of time, or even in a case like OP is dealing with, you are most likely not using the correct tool for the job. If you are using Excel, consider looking into Application.OnTime. (See the following section)


Alternatives to Pausing VBA Execution and Better Solution for OP

The question op has asked does not lead to the best solution for his problem. It's an XY-Problem.

It is not actually necessary to have VBA code running non-stop in the background in order to recalculate a Workbook every second. This is a typical example of a task that can also be achieved with Application.OnTime.

A detailed guide including a copy-paste solution to recalculate any Range at any desired time interval ≥ 1s is available here.

The big advantage of using Application.OnTime for this is that it avoids a continuously running macro and hence allows the use of other macros or other features that are unavailable while macros are running.


Meta-Analysis of All Other Solutions in This Thread

The reason I even wrote this answer is that all other solutions presented in this thread (at the time this post was written) have at least one of the following two severe drawbacks:

  1. They freeze the calling application completely, causing it to no longer respond to user input, or
  2. They cause excessive CPU usage (100% on the calling application's thread) by calling DoEvents in a loop.

Additionally, many of the proposed solutions have other issues:

  1. Some only work on Windows

  2. Some only work in Excel

  3. Some have an intrinsic imprecision of more than one second

  4. Some have other problems or even bugs

The following table will give a short overview of all the solutions in this thread and their features

Legend

Column ✅ (Good) ❌ (Bad)
App Responds App stays responsive and usable Freezes calling app completely
CPU Usage Practically no CPU usage 100% CPU usage in the single executing thread
Cross-App Works outside Excel Works only in Excel
Win/Mac Works on both, Windows and Mac Only works on Windows
Precise Time precision < 0.1 seconds Time precision > 0.1 seconds (usually about 1 second)
Other Issues No other issues Has some other issues described in the table below

Overview

Solution By App Responds CPU Usage Cross-App Win/Mac Precise Other Issues
Ben S (accepted)
Buggabill
Achaibou Karim
Maycow Moura
clemo
cyberpunk
dbuskirk
Reverus
Anastasiya-Romanova 秀
Appscript.me
Brian Burns
g t
ITI
dave
GWD (this post)

Other issues

Solution by Other issues
cyberpunk This solution will sleep indefinitely if at the time of calling Timer() + vSeconds > 172800 (vSevonds is the input value). In practice, this shouldn't be a big problem because Timer() is always ≤ 86400 so the input value needs to be bigger than 86400 which is one day. Such functions usually shouldn't be called for such long times anyways.
Reverus This solution doesn't allow pausing for a specific amount of time at all! You just specify how often you want to call DoEvents before continuing. How long this is, depends on the speed of your system. On my PC, calling the function with the maximum value a Long can take (2147483647) (so the maximum time the function can pause) will pause for about 1434 seconds or about 24 minutes. Obviously, this is a terrible "solution".
Brian Burns This solution will sleep indefinitely if at the time of calling Timer() + sngSecs > 86400 (sngSecs is the input value). Because Timer() can return values up to 86400, calling this function right before midnight can cause this bug even with very small input values. This is a severe bug and should be considered!
g t This solution does not wait at all. If you consider its generalization, Application.Wait Second(Now) + dblInput, it will not wait at all for input values smaller than CDbl(Now) - 60# / 86400#, which is 44815 at the time of writing this, and for input values larger than that, it will wait for dblInput - CDbl(Now) - Second(Now) / 86400# days. While input values can be constructed that will make this wait for a reasonable amount of time, this is very difficult. A terrible "solution".
ITI The comment describes this function as being able to cause delays of up to 99 seconds. This is wrong because input values where T Mod 100 > 60(T is the input parameter) will cause an error and hence stop execution indefinitely if the error is not handled by the calling code. You can confirm this by calling the function like this: Delay 61
dave This solution will work correctly but additionally sets Application.EnableEvents = True for no reason at all. If the calling code set this property to False and reasonably doesn't expect a function that has nothing to do with this to set it to True, this can lead to severe bugs in the calling code. If that line is deleted, the solution is fine.