Search and Replace Embedded Chart in PowerPoint

[Aussiebear]

It looks like the issue might stem from how the code interacts with the embedded Excel charts and OLE objects. Specifically, the repeated use of GetObject(, "Excel.Application") within the loops could be causing problems.

Here's a breakdown of potential issues and how to address them:

1. Leaving Excel Instances Open: The code activates the chart data in Excel and opens embedded Excel objects but then closes the workbooks (Wb.Close (0)). However, it doesn't explicitly quit the Excel application object (excelApplication). This could lead to multiple instances of Excel running in the background, potentially interfering with subsequent attempts to access embedded objects on later slides.
2. Race Conditions or Timing: When dealing with COM objects like Excel, sometimes operations might not complete instantaneously. Repeatedly getting the active Excel application and immediately trying to interact with its workbooks might lead to errors if the application hasn't fully initialized or if the correct workbook isn't yet active.
3. Scope of excelApplication: While excelApplication is declared at the top of the sub, it's repeatedly set within the loops. It might be more efficient to set it once at the beginning if needed for the entire process. However, the core issue is likely the failure to properly manage the Excel application instance.

Sub Chart___Testing_Revised()
    Dim oPres       As Presentation
    Dim oSlide      As Slide
    Dim oShape      As Shape
    Dim myChart     As PowerPoint.Chart
    Dim Wb          As Object 
    ' Late binding, can hold either Excel.Workbook or OLEObject
    Dim excelApp    As Object 
    ' To hold the Excel application object
    'Dim excelApplication As Object 
    ' Removed redundant declaration
    Dim LastYear    As String
    Dim ThisYear    As String
    Dim oSheet      As Object
    Dim answer      As Integer
    Dim execFlag    As Boolean
    answer = MsgBox("This Macro will ...., Continue?")
    If answer = vbNo Then
        GoTo ErrorHandler
    End If
    ' Get the active presentation
    Set oPres = ActivePresentation
    ' Attempt to get an existing Excel instance, or create a new one if none exists
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If excelApp Is Nothing Then
        Set excelApp = CreateObject("Excel.Application")
    End If
    ' Keep Excel hidden unless explicitly needed for user interaction
    excelApp.Visible = False
    excelApp.DisplayAlerts = False 
    ' To prevent prompts
    ' Loop through each slide
    For Each oSlide In oPres.Slides
        ' Loop through each shape on the slide
        For Each oShape In oSlide.Shapes
            If oShape.HasChart Then
                Set myChart = oShape.Chart
                    myChart.ChartData.Activate
                    ' Set the active workbook
                    Set Wb = excelApp.ActiveWorkbook
                    On Error Resume Next
                    Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana"
                    On Error GoTo 0 
                    ' Turn error handling back on
                    On Error Resume Next
                    Wb.UpdateLink Name:=Wb.LinkSources
                    On Error GoTo 0
                    ' Check if this is a Gain and Loss chart
                    If Wb.Worksheets("Data").Range("AA1").Value = "GainandLoss" Then
                        Wb.Worksheets("Data").Range("AB1").Value = 9
                        Wb.Worksheets("Data").Range("AC1").Value = 9
                        ' Put A Updated Textbox
                        Dim Tb As Shape 
                        ' Declare Tb here to limit scope
                        Set Tb = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=oShape.Left, Top:=oShape.Top, Width:=100, Height:=25)
                        Tb.Name = "Delete_" & oShape.Name
                        Tb.Fill.ForeColor.RGB = RGB(255, 255, 0)
                        Tb.TextFrame.TextRange.Text = "Updated"
                        Tb.TextFrame.TextRange.Font.Size = 8
                    End If
                    Wb.Close SaveChanges:=False 
                    ' Specify not to save changes
                ElseIf 
                    oShape.Type = msoEmbeddedOLEObject Then
                    On Error Resume Next
                    Set Wb = oShape.OLEFormat.Object
                    On Error GoTo 0
                    ' Check if the OLE object is an Excel Workbook
                    If TypeName(Wb) = "Workbook" Then
                        ' No need to explicitly open using DoVerb if we have the object
                        On Error Resume Next                    
                        Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana"
                        On Error GoTo 0
                        On Error Resume Next
                        Wb.UpdateLink Name:=Wb.LinkSources
                        On Error GoTo 0 
                        ' Change Cell A1 value
                        Wb.Worksheets("Data").Range("A1").Value = "AA"
                        Wb.Close SaveChanges:=False   ' Specify not to save changes
                        ' Put A Updated Textbox
                        Dim Tb As Shape 
                        ' Declare Tb here to limit scope
                        Set Tb = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=oShape.Left, Top:=oShape.Top, Width:=100, Height:=25)
                        Tb.Name = "Delete_" & oShape.Name
                        Tb.Fill.ForeColor.RGB = RGB(255, 255, 0)
                        Tb.TextFrame.TextRange.Text = "Updated New link: " & NewAddress 
                        ' NewAddress is not defined
                        Tb.TextFrame.TextRange.Font.Size = 8
                    End If
                End If
            Next oShape
        Next oSlide
        CleanUp:
        ' Ensure Excel is closed if we created a new instance
        If excelApp Is Nothing Then
            ' Do nothing as we didn't create it
        Else
            ' Check if any workbooks are still open
            If excelApp.Workbooks.Count = 0 Then
                excelApp.Quit
            End If
        End If
        Set excelApp = Nothing 
        ' Release the object variable
        ErrorHandler:    MsgBox "Finish!"
End Sub