Chart data becomes inaccessible after updating PPTX chart with Excel VBA

[alexos]

Hi there

First time posting on here so hope you can help.

I have an Excel VBA macro that updates a PowerPoint presentation. The macro seems to run fine, but when I later go and reopen the saved PowerPoint file, I can't get into the Excel worksheet behind the Chart anymore. I see this error message:

My code is quite long and doing lots of things but this is the main part. There is a main macro (test_UpdatePowerPoint) and then my plan from there is to have an individual Sub per chart I want to update. I include an example of the first chart to update. I suspect the error is in the second sub (test_01_RankChart) but include everything incase that is easier to see what is going on.

Sub test_UpdatePowerPoint()

    Dim templatePath As String
    Dim outPath As String
    Dim mySaveReportFile As String
    Dim templateFile As String
    
    Dim myCheck As Variant
    
    ' Read Worksheet Data
    myPath = ThisWorkbook.Path
    myMacro = ThisWorkbook.Name

    Workbooks(myMacro).Activate
    Sheets("Variables").Activate

    templatePath = ThisWorkbook.Path & "\" & Range("C3").Value
    logoPath = ThisWorkbook.Path & "\" & Range("C5").Value
    outPath = ThisWorkbook.Path & "\" & Range("C6").Value
    templateFile = Range("C7").Value
    
    curQ = Range("C12").Value
    lastQ = Range("C13").Value
    
    ' Start PowerPoint
    Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = 1
    Set oPPTFile = oPPTApp.Presentations.Open(Filename:=templatePath & "\" & templateFile)
    
    ' UPDATE THE FIRST SLIDE
    Call test_01_RankChart(8, "MMS Data")
    
    mySaveReportFile = curQ & " Report.pptx"
      
    ' Check to see if presentation already exists, if it does, kill it.
    ChDir outPath
    myCheck = Dir(mySaveReportFile, vbNormal)
    If myCheck <> "" Then
        Kill mySaveReportFile
    End If
                    
    ' Save it and close it
    oPPTFile.SaveAs outPath & "\" & mySaveReportFile
    oPPTFile.Close
            
    ' Close Powerpoint and empty variables
    oPPTApp.Quit
    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
        
    Workbooks(myMacro).Activate
    Sheets("Variables").Activate

End Sub

Sub test_01_RankChart(oSlNum As Integer, varSheet As String)

    Dim oPPTSlide As PowerPoint.Slide
    Dim oPPTChart As PowerPoint.Shape
    Dim sourceSheet As Worksheet
    Dim i As Integer
    
    Dim lastRow As Integer
    
    Set oPPTSlide = oPPTFile.Slides(oSlNum)
    oPPTSlide.Select
    
    Set sourceSheet = Workbooks(myMacro).Sheets(varSheet)
    
    ' Find last used cell in Column A (excluding the Category Average row at row 50)
    i = 2
    Do Until sourceSheet.Cells(i, 1).Value = ""
        i = i + 1
    Loop
    lastRow = i - 1

    
    Set oPPTChart = oPPTSlide.Shapes("Chart 1")
    
    With oPPTChart.Chart.ChartData.Workbook.Sheets(1)
        .Cells(1, 2).Value = curQ
        For i = 2 To lastRow
            .Cells(i, 1).Value = sourceSheet.Cells(i, 1).Value
            .Cells(i, 2).Value = sourceSheet.Cells(i, 4).Value
        Next i
    End With
    
    oPPTChart.Chart.ChartData.Workbook.Close
    oPPTChart.Chart.Refresh
    
    Set oPPTChart = Nothing
    Set oPPTSlide = Nothing
    Set sourceSheet = Nothing
    
End Sub

I'd be very grateful for any help.

Thank you!

 

[alexos]

I think I may have solved this myself with one simple line:

oPPTChart.Chart.ChartData.Activate

For context, this was placed before I started messing with data in the second sub. This part....

    Set oPPTChart = oPPTSlide.Shapes("Chart 1")
    
    oPPTChart.Chart.ChartData.Activate
    
    With oPPTChart.Chart.ChartData.Workbook.Sheets(1)
        .Cells(1, 2).Value = curQ
        For i = 2 To lastRow
            .Cells(i, 1).Value = sourceSheet.Cells(i, 1).Value
            .Cells(i, 2).Value = sourceSheet.Cells(i, 4).Value
        Next i
    End With
    
    oPPTChart.Chart.ChartData.Workbook.Close
    oPPTChart.Chart.Refresh

Not sure why it's needed but apparently it is! Live and learn!