Macro prevents powerpoint slides from advancing automatically with timings

Alaska 1 Reputation point
2021-03-10T02:24:24.37+00:00

Hello

I have a multi-slide powerpoint with linked content from Excel. I wanted a macro to automatically refresh the linked objects every minute, so that any updates to the data in excel were pulled through to the powerpoint.

I found vba code from AndrewMWebster's answer on https://social.msdn.microsoft.com/Forums/en-US/9f6891f2-d0c4-47a6-b63f-48405aae4022/powerpoint-run-macro-on-timer?forum=isvvba

I also found code to refresh linked objects from https://stackoverflow.com/a/41349894 , which is the only code that seems to actually update my linked objects (I have tried many others).

So I copied the code to refresh linked objects into the bottom of AndrewMWebster's code (Sub HelloTimer ()). The macro executes correctly. However, the powerpoint gets stuck on the first slide in presentation mode and does not advance according to the set timings which I set from the transitions tab.

Can anyone please help with how to get the slides to advance by themselves while I have the macro running?
Manually clicking to advance slides is not an option as this powerpoint is playing on an large screen as a dashboard, so it needs to run automatically.

I have little knowledge of VBA, help is much appreciated.

My code below:

'---------


Option Explicit

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

Dim lngTimerID As LongPtr
Dim blnTimer As Boolean
Const HOW_LONG As Long = 60000 'Sets the time in 1/1,000's of a second
'

Sub StartOnTime()
' ----------------------------------------------------------------
' Procedure Name: StartOnTime
' Purpose: Call this to start the time
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Andrew Webster
' Date: 10/26/2019
' ----------------------------------------------------------------
    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, HOW_LONG, AddressOf HelloTimer)
        If lngTimerID = 0 Then
            MsgBox "Error : Timer Not Generated "
            Exit Sub
        End If
        blnTimer = True

    End If
End Sub

Sub KillOnTime()
' ----------------------------------------------------------------
' Procedure Name: KillOnTime
' Purpose: Call this to stop the timer
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Andrew Webster
' Date: 10/26/2019
' ----------------------------------------------------------------
    lngTimerID = KillTimer(0, lngTimerID)
    blnTimer = False
End Sub


Private Sub HelloTimer()
' ----------------------------------------------------------------
' Procedure Name: HelloTimer
' Purpose: This is called repeatedly by StartOnTime
' Procedure Kind: Sub
' Procedure Access: Private
' Author: Andrew Webster
' Date: 10/26/2019
' ----------------------------------------------------------------

Dim sld As Slide, shp As Shape

For Each sld In ActivePresentation.Slides

   For Each shp In sld.Shapes
     On Error Resume Next
     shp.LinkFormat.update
    Next

Next


End Sub
{count} votes