Search and Replace Embedded Chart in PowerPoint

[yurble_vn]

Dear All,

I created a vba to work with Chart/Embedded Chart in Powerpoint: Update Linked Data, Edit a Particular Cell, and Do Search and Replace.

For PowerPoint Native Charts: My code works well for all native charts in PowerPoint.
For Embedded charts: My codes worked well for "update linked data". But, it can only do "search and replace", "Edit cell" for embedded object in first slide. From 2nd slide onward, it does NOT do search and replace or edit the excel embedded object. I put two embedded charts in 1st slide, both got updated. But from 2nd slide onward, this VBA did not open the object in excel. This is quite weird...

Appreciate your help to advise:

Sub Chart___Testing()

    Dim oPres       As Presentation
    Dim oSlide      As Slide
    Dim oShape      As Shape
    Dim myChart     As PowerPoint.Chart
    Dim Wb, Tb         As Object
    Dim excelApplication As Object
    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
    
    ' 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
                'Get Excel App
                Set excelApplication = GetObject(, "Excel.Application")
                Set Wb = excelApplication.ActiveWorkbook


                On Error Resume Next
                 Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana"
                        
                  On Error Resume Next
                   Wb.UpdateLink Name:=Wb.LinkSources


                 '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
                    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 (0)


            Else
                If oShape.Type = msoEmbeddedOLEObject Then
                    Set Wb = oShape.OLEFormat.Object
                    On Error Resume Next
                    'Check if the OLE object is an Excel Workbook
                    If TypeName(Wb) = "Workbook" Then
                        'Open Embedded Excel with option '2' (open in excel)
                        nCount = 0
                        For Each sVerb In oShape.OLEFormat.ObjectVerbs
                            nCount = nCount + 1
                            If sVerb = "Open" Then
                                oShape.OLEFormat.DoVerb nCount
                            End If
                        Next sVerb
                        'Get Excel App
                        Set excelApplication = GetObject(, "Excel.Application")
                        Set Wb = excelApplication.ActiveWorkbook
                        '
                        On Error Resume Next
                        Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana"
                        
                        On Error Resume Next
                        Wb.UpdateLink Name:=Wb.LinkSources
                        
                        'Change Cell A1 value
                        Wb.Worksheets("Data").Range("A1").Value = "AA"
                        Wb.Close (0)
                        
                        'Put A Updated Textbox
                        Set Wb = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=oShape.Left, Top:=oShape.Top, Width:=100, Height:=25)
                        Wb.Select
                        Wb.Name = "Delete_" & oShape.Name
                        Wb.Fill.ForeColor.RGB = RGB(255, 255, 0)
                        Wb.TextFrame.TextRange.Text = "Updated New link: " & NewAddress
                        Wb.TextFrame.TextRange.Font.Size = 8
                    End If
                End If
            End If
    Next oShape
    
Next oSlide
ErrorHandler:
MsgBox "Finish!"
End Sub