How do I make a PowerPoint Charts automatically update?

Question

I have a presentation that I want to loop continuously in presentation mode and automatically update the charts in the presentation. I have found that you can do this with links but as soon as you close either the .ppt or the .xls the links no longer update automatically.

To get around this I parsed together a macro from across the interwebs that I think would work. I'm just having a problem creating the triggering event. I found this website that pointed me in the right direction (I think), I just don't know what to do with it. "http://youpresent.co.uk/powerpoint-application-events-in-vba/" The website has a .pptm that I downloaded that had most of the below code in it. Any help would be greatly appreciated.

Does anyone have a solution for this? I'm pretty much open to any suggestions.

My current module is:

    Option Explicit

Public oEH As New clsAppEVents

Sub slides()
    Dim pptSlide As slide
    Dim pptShape As Shape
    Dim SourceFile, FilePath As String
    Dim position As Integer
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim i As Integer
    
    i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
    If i = 1 Then
    
        Set xlApp = New Excel.Application
            xlApp.Visible = False
            xlApp.DisplayAlerts = False
            
        For Each pptSlide In ActivePresentation.slides
            For Each pptShape In pptSlide.Shapes
    
                If pptShape.Type = 3 Then
                    SourceFile = pptShape.LinkFormat.SourceFullName
                    position = InStr(1, SourceFile, "!", vbTextCompare)
                    If position <> 0 Then
                        SourceFile = Left(SourceFile, position - 1)
                    End If
                    Set xlWB = xlApp.Workbooks.Open(SourceFile, True, True)
                        pptShape.LinkFormat.Update
                    xlWB.Close
                    Set xlWB = Nothing
                    
                End If
            Next
        Next
    End If
End Sub
Private Sub App_SlideShowNextClick(ByVal Wn As SlideShowWindow, ByVal nEffect As Effect)
    Set oEH.App = Application
    Call slides
End Sub

I have a class module clsAppEvents

Public WithEvents App As Application

Private Sub App_AfterDragDropOnSlide(ByVal Sld As slide, ByVal X As Single, ByVal Y As Single)
Debug.Print "App_AfterDragDropOnSlide"
End Sub

Private Sub App_AfterNewPresentation(ByVal Pres As Presentation)
Debug.Print "App_AfterNewPresentation"
End Sub

Private Sub App_AfterPresentationOpen(ByVal Pres As Presentation)
Debug.Print "App_AfterPresentationOpen"
End Sub

Private Sub App_AfterShapeSizeChange(ByVal shp As Shape)
Debug.Print "App_AfterShapeSizeChange"
End Sub

Private Sub App_ColorSchemeChanged(ByVal SldRange As SlideRange)
Debug.Print "App_ColorSchemeChanged"
End Sub

Private Sub App_NewPresentation(ByVal Pres As Presentation)
Debug.Print "App_NewPresentation"
End Sub

Private Sub App_PresentationBeforeClose(ByVal Pres As Presentation, Cancel As Boolean)
Debug.Print "App_PresentationBeforeClose"
End Sub

Private Sub App_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)
Debug.Print "App_PresentationBeforeSave"
End Sub

Private Sub App_PresentationClose(ByVal Pres As Presentation)
Debug.Print "App_PresentationClose"
End Sub

Private Sub App_PresentationCloseFinal(ByVal Pres As Presentation)
Debug.Print "App_PresentationCloseFinal"
End Sub

Private Sub App_PresentationNewSlide(ByVal Sld As slide)
Debug.Print "App_PresentationNewSlide"
End Sub

Private Sub App_PresentationOpen(ByVal Pres As Presentation)
Debug.Print "App_PresentationOpen"
End Sub

Private Sub App_PresentationPrint(ByVal Pres As Presentation)
Debug.Print "App_PresentationPrint"
End Sub

Private Sub App_PresentationSave(ByVal Pres As Presentation)
Debug.Print "App_PresentationSave"
End Sub

Private Sub App_PresentationSync(ByVal Pres As Presentation, ByVal SyncEventType As Office.MsoSyncEventType)
Debug.Print "App_PresentationSync"
End Sub

Private Sub App_ProtectedViewWindowActivate(ByVal ProtViewWindow As ProtectedViewWindow)
Debug.Print "App_ProtectedViewWindowActivate"
End Sub

Private Sub App_ProtectedViewWindowBeforeClose(ByVal ProtViewWindow As ProtectedViewWindow, ByVal ProtectedViewCloseReason As PpProtectedViewCloseReason, Cancel As Boolean)
Debug.Print "App_ProtectedViewWindowBeforeClose"
End Sub

Private Sub App_ProtectedViewWindowBeforeEdit(ByVal ProtViewWindow As ProtectedViewWindow, Cancel As Boolean)
Debug.Print "App_ProtectedViewWindowBeforeEdit"
End Sub

Private Sub App_ProtectedViewWindowDeactivate(ByVal ProtViewWindow As ProtectedViewWindow)
Debug.Print "App_ProtectedViewWindowDeactivate"
End Sub

Private Sub App_ProtectedViewWindowOpen(ByVal ProtViewWindow As ProtectedViewWindow)
Debug.Print "App_ProtectedViewWindowOpen"
End Sub

Private Sub App_SlideSelectionChanged(ByVal SldRange As SlideRange)
Debug.Print "App_SlideSelectionChanged"
End Sub

Private Sub App_SlideShowBegin(ByVal Wn As SlideShowWindow)
Debug.Print "App_SlideShowBegin"
End Sub

Private Sub App_SlideShowEnd(ByVal Pres As Presentation)
Debug.Print "App_SlideShowEnd"
End Sub

Private Sub App_SlideShowNextBuild(ByVal Wn As SlideShowWindow)
Debug.Print "App_SlideShowNextBuild"
End Sub

Private Sub App_SlideShowNextClick(ByVal Wn As SlideShowWindow, ByVal nEffect As Effect)
Debug.Print "App_SlideShowNextClick"
End Sub

Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
Debug.Print "App_SlideShowNextSlide"
End Sub

Private Sub App_SlideShowOnNext(ByVal Wn As SlideShowWindow)
Debug.Print "App_SlideShowOnNext"
End Sub

Private Sub App_SlideShowOnPrevious(ByVal Wn As SlideShowWindow)
Debug.Print "App_SlideShowOnPrevious"
End Sub

Private Sub App_WindowActivate(ByVal Pres As Presentation, ByVal Wn As DocumentWindow)
Debug.Print "App_WindowActivate"
End Sub

Private Sub App_WindowBeforeDoubleClick(ByVal Sel As Selection, Cancel As Boolean)
Debug.Print "App_WindowBeforeDoubleClick"
End Sub

Private Sub App_WindowBeforeRightClick(ByVal Sel As Selection, Cancel As Boolean)
Debug.Print "App_WindowBeforeRightClick"
End Sub

Private Sub App_WindowDeactivate(ByVal Pres As Presentation, ByVal Wn As DocumentWindow)
Debug.Print "App_WindowDeactivate"
End Sub

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
Debug.Print "App_WindowSelectionChange"
End Sub

Answer 1

I abandoned all hope on doing this based on my previous requirements. To get around the issue of having good charts, I created an Excel Macro to create a new PowerPoint presentation and paste all of the charts I want to it while maintaining the source formatting. This caused issues because of having to use the ExecuteMso. below is the code.

Sub rtnPasteCharts()
    'declare ppt object vars
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim SldIndex As Integer
    'declare excel object vars
    Dim chrt As ChartObject
    'create a new instance of ppt
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True
    'creates a new presentation within the application
    Set PPTPres = PPTApp.Presentations.Add
    'create an index handler for slide creation
    SldIndex = 1
    'loop thru each chart objects on activesheet
    LastRow = Sheet6.Cells(Sheet6.Rows.Count, "R").End(xlUp).Row
    For Each chrt In ActiveSheet.ChartObjects
        For i = 2 To LastRow
            chrtTitle = Sheet6.Cells(i, 18).Text
            If chrt.Chart.ChartTitle.Text = chrtTitle Then
                Application.CutCopyMode = True
                chrt.Copy
                'creates a new slide
                Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
                'sets the slideshow transition timings
                With PPTPres.Slides(SldIndex).SlideShowTransition
                    .AdvanceOnClick = msoTrue
                    .AdvanceOnTime = msoTrue
                    .AdvanceTime = 30
                End With
                PPTSlide.Select
               'Creates a pause between selecting and pasting
                For j = 1 To 5000: DoEvents: Next
                PPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
                PPTApp.CommandBars.ReleaseFocus
                SldIndex = SldIndex + 1
            End If
        Next i
    Next
End Sub

Shout out to Sigma Coding video for getting me close. https://www.youtube.com/watch?v=DOaBtYMCCEM