I have an Excel worksheet that has the following开发者_如何学编程 macro. I'd like to loop it every second but danged if I can find the function to do that. Isn't it possible?
Sub Macro1()
'
' Macro1 Macro
'
Do
Calculate
'Here I want to wait for one second
Loop
End Sub
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
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.
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
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
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
Application.Wait Second(Now) + 1
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
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
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
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:
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 theSleep
subs toPrivate
because it is impossible to import API functions asPublic
inside a class module.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 around1.015 ± 0.02
seconds on Windows.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:
- They freeze the calling application completely, causing it to no longer respond to user input, or
- 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:
Some only work on Windows
Some only work in Excel
Some have an intrinsic imprecision of more than one second
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. |
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
You can use Application.wait now + timevalue("00:00:01") or Application.wait now + timeserial(0,0,1)
Try this :
Threading.thread.sleep(1000)
精彩评论