Sleep / wait timer in PowerPoint VBA that's not CPU intensive

Question

I'm currently having a PowerPoint presentation that's being used on a computer as some sort of kiosk or information screen. It reads it's text from a text file on the disk. The text in this text file is displayed in a textbox in PowerPoint and this is being refresh every 5 seconds. This way we can edit the text in the PowerPoint without editing the PowerPoint presentation itself so it will continue to run. Work great so far, only PowerPoint VBA does not contain the Application.Wait function. See here the full sub:

Sub Update_textBox_Inhoud()

Dim FileName As String
TextFileName = "C:\paht\to\textfile.txt"
If Dir$(FileName) <> "" Then

Application.Presentations(1).SlideShowSettings.Run
Application.WindowState = ppWindowMinimized


While True


    Dim strFilename As String: strFilename = TextFileName
    Dim strFileContent As String
    Dim iFile As Integer: iFile = FreeFile
    Open strFilename For Input As #iFile
    strFileContent = Input(LOF(iFile), iFile)
    Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
    Close #iFile


    waitTime = 5
    Start = Timer
    While Timer < Start + waitTime
        DoEvents
    Wend

Wend

Else

End If
End Sub

As you can see I've got a loop within a loop to create a 5 second sleep / wait function, as PowerPoint doesn't have a Application.Wait function.

While running this macro my CPU load on my 7th gen i5 goes up to 36%. The kiosk computer has slightly worse hardware so the CPU load will be quite high and the fan of this PC will make a lot of noise.

I think the sleep / wait function doesn't really "sleep", it just continues to loop until 5 seconds have past.

Question 1 : Is my assumption that the function doesn't really sleep true? Question 2 : If the answer to question 1 is true, is there a better, less CPU intensive way, to create a sleep function?

Florent B. · Accepted Answer · 2019-07-30T14:43:59.503

9

To wait for a specific amount of time, call WaitMessage followed by DoEvents in a loop. It's not CPU intensive and the UI will remain responsive:

Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long


Public Sub Wait(Seconds As Double)
    Dim endtime As Double
    endtime = DateTime.Timer + Seconds
    Do
        WaitMessage
        DoEvents
    Loop While DateTime.Timer < endtime
End Sub

edited Jul 30 '19 at 14:43

answered Jul 30 '19 at 11:55

Florent B.

41,537
7
86
101

1

This indeed solved it for me. CPU is running between 0% & 1%, PowerPoint is not unresponsive. Thank you! – Roy Jul 30 '19 at 12:34

score 1 · Answer 2 · answered Dec 12 '22 at 16:28

Here is my ultimate sleep procedure, featuring all the benefits all together:

<0.0% CPU
DoEvents
Accuracy +-<10ms

Public Sub Sleep(ms As Currency)
    Dim cTimeStart As Currency, cTimeEnd As Currency
    Dim dTimeElapsed As Currency, cTimeTarget As Currency
    Dim cApproxDelay As Currency
    
    getTime cTimeStart
    
    Static cPerSecond As Currency
    If cPerSecond = 0 Then getFrequency cPerSecond
    
    cTimeTarget = ms * (cPerSecond / 1000)
    
    If ms <= 25 Then
        'empty loop for improved accuracy (SleepAPI alone costs 2-15ms and DoEvents 2-8ms)
        Do
            getTime cTimeEnd
        Loop Until cTimeEnd - cTimeStart >= cTimeTarget
        Exit Sub
    Else 'fully featured loop
        SleepAPI 5 '"WaitMessage" avoided because it costs 0.0* to 2**(!) ms
        DoEvents
        getTime cTimeEnd
        cApproxDelay = (cTimeEnd - cTimeStart) / 2
        
        cTimeTarget = cTimeTarget - cApproxDelay
        Do While (cTimeEnd - cTimeStart) < cTimeTarget
            SleepAPI 1
            DoEvents
            getTime cTimeEnd
        Loop
    End If
End Sub

@GrahamCharles, "Currency" here is a good-enough workaround to avoid the complexity of LARGE_INTEGER (see https://stackoverflow.com/a/31387007) — 6diegodiego9, Jul 14 '23 at 12:39

TourEiffel · Answer 3 · 2019-07-30T09:29:22.590

0

Sleep does not require CPU cycle.

Sleep is a windows function and not a VBA Function, but you can still use this function in VBA code by calling the windows Sleep API. Actually sleep is a function present inside Windows DLL files. So, before using them you have to declare the name of API above the code in your module.

The syntax of Sleep statement is as follows:

Sleep (delay)

Example :

#If VBA7 Then  
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems  
#Else  
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems  
#End If  
Sub SleepTest()  
MsgBox "Execution is started"  
Sleep 10000 'delay in milliseconds  
MsgBox "Execution Resumed"  
End Sub

So basicly your code would be as below :

#If VBA7 Then

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

#Else

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

#End If

    Sub Update_textBox_Inhoud()

    Dim FileName As String
    TextFileName = "C:\paht\to\textfile.txt"
    If Dir$(FileName) <> "" Then
        Application.Presentations(1).SlideShowSettings.Run
        Application.WindowState = ppWindowMinimized

        While True
            Dim strFilename As String: strFilename = TextFileName
            Dim strFileContent As String
            Dim iFile As Integer: iFile = FreeFile
            Open strFilename For Input As #iFile
            strFileContent = Input(LOF(iFile), iFile)
            Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
            Close #iFile

           Sleep 5000
        Wend
    Else

    End If
    End Sub

Conclusion : You didn't use the real sleep function. What you were doing was using CPU Cycle..

Note that several information in this answer were found on this website : --> source

edited Jul 30 '19 at 09:29

answered Jul 30 '19 at 09:20

TourEiffel

4,034
2
16
45

Thanks for this suggestion. I found this sleep function elsewhere also but when I add it in my code and run it, PowerPoint becomes unresponsive. As if it doesn't execute the sleep and just turns into an infinite loop. – Roy Jul 30 '19 at 09:36
What is your system ? @Roy 32 or 64 bits ? – TourEiffel Jul 30 '19 at 09:41
@Roy Maybe you can try with `Wait` function but it will use **CPU** .. want me to edit ? – TourEiffel Jul 30 '19 at 09:42
`dwMilliseconds` is always `As Long`, not `LongPtr`. – GSerg Jul 30 '19 at 10:23
@GSerg After reading your comment I doublechecked and all the sources I found are using LongPtr since we are calling a windows **64 Bits** API. Can you please forward me your source ? – TourEiffel Jul 30 '19 at 10:29
1

Then stop using those sources and use documentation instead. Saying that `LongPtr` should be used *because it's a Windows API* makes no sense. `LongPtr` should be used for pointer-sized values. `Sleep` [accepts a `DWORD`](https://learn.microsoft.com/en-us/windows/win32/api/synchapi/nf-synchapi-sleep). A `DWORD` is a [32-bit unsigned integer](https://learn.microsoft.com/en-us/windows/win32/winprog/windows-data-types) regardless of the OS bitness. An example of a pointer-sized value would be `HWND`, which is `HANDLE`, which is `PVOID`, which is a *pointer* to `void`. – GSerg Jul 30 '19 at 10:32
@GSerg so what about **64 bit** machine ? – TourEiffel Jul 30 '19 at 10:33
Maybe give a try with long and with excel **64 bit** you will face an issue :) – TourEiffel Jul 30 '19 at 10:34
1

Maybe you should try that yourself too. Like I said before, `Sleep` accepts a 32-bit integer value on both 32-bit and 64-bit Windows, which is a `Long` in VBA. – GSerg Jul 30 '19 at 10:35
i did try : I got the following compile error -> The code in the project must be updated for use on 64-bit systems. – TourEiffel Jul 30 '19 at 10:41
Apparently you removed `PtrSafe` too. You should have kept that in place. You should have only replaced the `LongPtr` with `Long`. You still must have two declarations, one with `PtrSafe` and one without, but both must use `dwMilliseconds As Long`. – GSerg Jul 30 '19 at 10:45

Tim Stack · Answer 4 · 2019-07-30T09:52:26.557

Try the following

#If VBA7 Then

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

#Else

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

#End If

Sub Update_textBox_Inhoud()

Dim FileName As String
TextFileName = "C:\paht\to\textfile.txt"
If Dir$(FileName) <> "" Then
    Application.Presentations(1).SlideShowSettings.Run
    Application.WindowState = ppWindowMinimized

    While True
        Dim strFilename As String: strFilename = TextFileName
        Dim strFileContent As String
        Dim iFile As Integer: iFile = FreeFile
        Open strFilename For Input As #iFile
        strFileContent = Input(LOF(iFile), iFile)
        Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
        Close #iFile

       Sleep 5000
    Wend
Else
    'Is there no code here?
End If
End Sub

It uses the Sleep API function, which is windows-based and therefore not limited to Excel.

Sleep uses a value in milliseconds, so in this case you need 5000

EDIT

#If VBA7 Then
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal _
    lpTimerFunc As Long) As Long

    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long 
#Else
    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal _
    lpTimerFunc As Long) As Long

    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If


Dim lngTimerID As Long
Dim blnTimer As Boolean

Sub StartOnTime()
    If blnTimer Then
        lngTimerID = KillTimer(0, lngTimerID)
        If lngTimerID = 0 Then
            MsgBox "Error : Timer Not Stopped"
            Exit Sub
        End If
        blnTimer = False

    Else
        lngTimerID = SetTimer(0, 0, 5000, AddressOf Update_textBox_Inhoud)
        If lngTimerID = 0 Then
            MsgBox "Error : Timer Not Generated "
            Exit Sub
        End If
        blnTimer = True
    End If
End Sub

Sub KillOnTime()
    lngTimerID = KillTimer(0, lngTimerID)
    blnTimer = False
End Sub

Sub Update_textBox_Inhoud()

Dim FileName As String
TextFileName = "C:\paht\to\textfile.txt"
If Dir$(FileName) <> "" Then
    Application.Presentations(1).SlideShowSettings.Run
    Application.WindowState = ppWindowMinimized

    Dim strFilename As String: strFilename = TextFileName
    Dim strFileContent As String
    Dim iFile As Integer: iFile = FreeFile
    Open strFilename For Input As #iFile
    strFileContent = Input(LOF(iFile), iFile)
    Application.Presentations(1).Slides(1).Shapes.Range(Array("textBox_Inhoud")).TextFrame.TextRange = strFileContent
    Close #iFile
Else
    'Is there no code here?
End If
End Sub

As per this thread

This will make the PowerPoint become unresponsive https://analystcave.com/vba-sleep-vs-wait/ — Roy, Jul 30 '19 at 09:40
Yes, but I assumed this not to be a problem as the `Sleep` function occurs after the presentation has been updated, and because presentations oftentimes feature static images. — Tim Stack, Jul 30 '19 at 09:44
On top of that, it's `SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr` and `KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long`. — GSerg, Jul 31 '19 at 07:08

Sleep / wait timer in PowerPoint VBA that's not CPU intensive

4 Answers4

Linked