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

[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

[yurble_vn]

Thanks Aussiebear,

I modified my code as following.
- I have to add in one fake step "Select Slide" when move to next slide. This fixed the issue on "VBA stop editing Embedded chart from 2nd slide onward".
- This code works fine except one thing: I have to open an Excel sheet in advance to make this code works. It seems the Open New Excel Instance did not work.

I did test this code without the that fake step of "select slide", it does not work.

Sub Chart___Testing()
    Dim oPres       As Presentation
    Dim oSlide      As Slide
    Dim oShape      As Shape
    Dim myChart     As PowerPoint.Chart
    Dim Wb          As Object
    Dim excelApp    As Object
    Dim answer      As Integer
    Dim ExecFlag    As Boolean
    
    'Reconfirm before Execute
    answer = MsgBox("This macro will update linked data in all charts, and embedded Excels." _
             & vbCrLf & "And update dyanmic tables that named 'Data'/'Table1' in 'Data'/'Sheet1' Sheets." _
             & vbCrLf & "DOES NOT WORK ON GROUPED CHARTS" & vbCrLf & "BACKUP FILE BEFORE RUNNING." & vbCrLf & "Continue?" _
             , vbQuestion + vbYesNo + vbDefaultButton2, "WARNING")
    
    If answer = vbNo Then
        GoTo ErrorHandler
    End If
    
    ExecFlag = False
    
    ' 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
        oSlide.Select
        ' Loop through each shape on the slide
        
        For Each oShape In oSlide.Shapes
            
            'Update PowerPointChart
            If oShape.HasChart Then
                Set myChart = oShape.Chart
                myChart.ChartData.Activate
                ExecFlag = True
                                
            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
                        oShape.OLEFormat.Activate
                        ExecFlag = True
                    End If
                End If
            End If
            If ExecFlag Then
                ' Set the active workbook
                Set Wb = excelApp.ActiveWorkbook
                On Error Resume Next
                'Update Link
                Wb.UpdateLink Name:=Wb.LinkSources
                On Error GoTo 0
                'Change Cell BZ1 value
                Wb.Worksheets("Data").Range("BZ1").Value = "AABBDED"
                'Search and Replace
                Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana"
                'Update Filter table
                On Error Resume Next
                Wb.Worksheets("Data").ListObjects("Data").Range.AutoFilter Field:=1, Criteria1:="<>0"
                On Error Resume Next
                Wb.Worksheets("Sheet1").ListObjects("Data").Range.AutoFilter Field:=1, Criteria1:="<>0"
                On Error Resume Next
                Wb.Worksheets("Data").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>0"
                On Error Resume Next
                Wb.Worksheets("Sheet1").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>0"
                'Refresh Screen and Close
                Wb.RefreshAll
                Wb.Close SaveChanges:=False   ' Specify not to save changes
                
                'Put A Updated Textbox
                Dim Tb As Shape
                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 Data"
                Tb.TextFrame.TextRange.Font.Size = 8
                Tb.Select
                'Turn off Execution Flag to check again next Shape
                ExecFlag = False
            End If
            
        Next oShape
    Next oSlide
CleanUp:
        ' Ensure Excel is closed if we created a new instance
        excelApp.DisplayAlerts = True
        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

[Aussiebear]

Your code is considerably different

[Aussiebear]

How does behave then?

Sub Chart___Testing_Revised_V6()
    ' Object Declarations
    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 Excel.Workbook or OLEObject
    Dim excelApp    As Object      ' Excel.Application object
    Dim TempSheet   As Object      ' Temporary worksheet object
    Dim Tb          As Shape       ' Textbox Shape object
    ' Variable Declarations
    Dim answer      As Integer
    Dim ExecFlag    As Boolean
    Dim wsName      As String
    Dim loName      As String
    Dim errNum      As Long
    ' Constants
    Const PROC_NAME As String = "Chart___Testing_Revised_V6" ' For error handling
    Const ERR_XL_APP_NOT_FOUND = 429 'Constant for Excel not found Error
    '## Main Procedure
    On Error GoTo ErrorHandler ' Enable error handling
    ' Get Presentation Object
    Set oPres = ActivePresentation
    ' Prompt User for Confirmation
    answer = MsgBox( _
        "This macro will update linked data in all charts and embedded Excels." & vbCrLf & "It will also update dynamic tables named 'Data'/'Table1' in 'Data'/'Sheet1' sheets." & vbCrLf & _
        "IMPORTANT: This macro does NOT work on GROUPED CHARTS." & vbCrLf & "BACKUP YOUR PRESENTATION FILE BEFORE RUNNING THIS MACRO." & vbCrLf & _
        "Continue?", vbQuestion + vbYesNo + vbDefaultButton2, "WARNING: Data Update Macro" )
    ' Exit if User Cancels
    If answer = vbNo Then
        Exit Sub ' Use Exit Sub for a cleaner exit
    End If
    ' Get or Create Excel Application Object
    '#Attempt to get an existing instance.  If none exists, create a new one.
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    errNum = Err.Number
    On Error GoTo 0
    If errNum = ERR_XL_APP_NOT_FOUND Then 'Use constant
        Set excelApp = CreateObject("Excel.Application")
    ElseIf errNum <> 0 Then
        ' Handle other errors during GetObject.
        GoTo ErrorHandler
    End If
    ' Configure Excel Application
    excelApp.Visible = False       ' Run in the background
    excelApp.DisplayAlerts = False ' Suppress prompts
    ' Loop Through Slides and Shapes
    For Each oSlide In oPres.Slides
        oSlide.Select 'Potentially needed for .Activate, but try to minimize use of Select/Activate
        For Each oShape In oSlide.Shapes
            ExecFlag = False ' Reset flag for each shape
            ' Handle Charts and Embedded Excel Objects
            If oShape.HasChart Then
                Set myChart = oShape.Chart
                myChart.ChartData.Activate 'Use Activate
                ExecFlag = True
            ElseIf oShape.Type = msoEmbeddedOLEObject Then
                Set Wb = oShape.OLEFormat.Object
                If TypeName(Wb) = "Workbook" Then
                    oShape.OLEFormat.Activate 'Use Activate
                    ExecFlag = True
                End If
            End If
            ' Process Excel Objects (Charts or Embedded)
            If ExecFlag Then
                Set Wb = excelApp.ActiveWorkbook ' Get the active workbook
                ' "Fake" Step: Activate a Worksheet (with error handling)
                On Error Resume Next
                Set TempSheet = Wb.Worksheets(1) ' Try the first sheet
                If Not TempSheet Is Nothing Then
                    TempSheet.Activate
                Else
                    Set TempSheet = Wb.Sheets.Add ' Add a sheet if no sheets exist
                    TempSheet.Activate
                End If
                On Error GoTo 0
                '  Update Links, Modify Data, and Update Tables (with error handling)
                On Error Resume Next
                Wb.UpdateLink Name:=Wb.LinkSources ' Update links
                Wb.Worksheets("Data").Range("BZ1").Value = "AABBDED" ' Modify cell value
                Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana" ' Search/replace
                '  Update List Object Filters (Consolidated and Improved)
                 For Each wsName In Array("Data", "Sheet1")
                    For Each loName In Array("Data", "Table1")
                         ' Construct sheet and listobject names, and handle errors robustly
                         On Error Resume Next
                          With Wb
                               If .Worksheets(wsName) Is Nothing Then
                                  GoTo NextLO 'If worksheet doesn't exist, go to the next listobject
                               End If
                               If .Worksheets(wsName).ListObjects(loName) Is Nothing Then
                                  GoTo NextLO 'If listobject doesn't exist, go to the next listobject
                               End If
                               .Worksheets(wsName).ListObjects(loName).Range.AutoFilter Field:=1, Criteria1:="<>0"
                            End With
                        NextLO:                   
                        On Error GoTo 0
                    Next loName
                Next wsName
                On Error GoTo 0
                Wb.RefreshAll      ' Refresh all connections
                Wb.Close SaveChanges:=False ' Close without saving changes
                Set Wb = Nothing
                ' Add "Updated Data" Textbox
                Set Tb = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, oShape.Left, oShape.Top, 100, 25)
                With Tb
                    .Name = "Delete_" & oShape.Name
                    .Fill.ForeColor.RGB = RGB(255, 255, 0)
                    .TextFrame.TextRange.Text = "Updated Data"
                    .TextFrame.TextRange.Font.Size = 8
                    .Select 'Consider if you really need to select.
                End With
                Set Tb = Nothing 'Clean up
            End If ' End If ExecFlag
        Next oShape
    Next oSlide
CleanUp:
    On Error Resume Next
    '## 13. Clean Up Excel Application
    If Not excelApp Is Nothing Then
        excelApp.DisplayAlerts = True
        excelApp.Quit ' Quit Excel
        Set excelApp = Nothing ' Release object
    End If
    On Error GoTo 0
    Exit Sub ' Use Exit Sub for normal termination
ErrorHandler:
    Dim errDesc As String
    errNum = Err.Number
    errDesc = Err.Description
    If errNum <> 0 Then
        MsgBox "Error in " & PROC_NAME & ":" & vbCrLf & "Error Number: " & errNum & vbCrLf & "Description:  " & errDesc, vbCritical, "Application Error"
    End If
    ' Resume CleanUp  ' Moved to before Exit Sub
    Resume CleanUp ' Ensure cleanup is executed
End Sub

[yurble_vn]

Thanks AussieBear

yes, it works perfectly. Just three small things:
- wsName, and loName have to be declared as 'Variant'
- oShape.OLEFormat.Activate can not be closed by wb.close , i have to change it back to Do.Verb.
- The Excel window still show up.

Sub Chart___Testing_Revised_V7()
    ' Object Declarations
    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 Excel.Workbook or OLEObject
    Dim excelApp    As Object      ' Excel.Application object
    Dim TempSheet   As Object      ' Temporary worksheet object
    Dim Tb          As Shape       ' Textbox Shape object
    ' Variable Declarations
    Dim answer      As Integer
    Dim ExecFlag    As Boolean
    Dim wsName      As Variant
    Dim loName      As Variant
    Dim errNum      As Long
    ' Constants
    Const PROC_NAME As String = "Chart___Testing_Revised_V6" ' For error handling
    Const ERR_XL_APP_NOT_FOUND = 429 'Constant for Excel not found Error
    '## Main Procedure
    On Error GoTo ErrorHandler ' Enable error handling
    ' Get Presentation Object
    Set oPres = ActivePresentation
    ' Prompt User for Confirmation
    answer = MsgBox( _
        "This macro will update linked data in all charts and embedded Excels." & vbCrLf & "It will also update dynamic tables named 'Data'/'Table1' in 'Data'/'Sheet1' sheets." & vbCrLf & _
        "IMPORTANT: This macro does NOT work on GROUPED CHARTS." & vbCrLf & "BACKUP YOUR PRESENTATION FILE BEFORE RUNNING THIS MACRO." & vbCrLf & _
        "Continue?", vbQuestion + vbYesNo + vbDefaultButton2, "WARNING: Data Update Macro")
    ' Exit if User Cancels
    If answer = vbNo Then
        Exit Sub ' Use Exit Sub for a cleaner exit
    End If
    ' Get or Create Excel Application Object
    '#Attempt to get an existing instance.  If none exists, create a new one.
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    errNum = Err.Number
    On Error GoTo 0
    If errNum = ERR_XL_APP_NOT_FOUND Then 'Use constant
        Set excelApp = CreateObject("Excel.Application")
    ElseIf errNum <> 0 Then
        ' Handle other errors during GetObject.
        GoTo ErrorHandler
    End If
    ' Configure Excel Application
    excelApp.Visible = False       ' Run in the background
    excelApp.DisplayAlerts = False ' Suppress prompts
    ' Loop Through Slides and Shapes
    For Each oSlide In oPres.Slides
        oSlide.Select 'Potentially needed for .Activate, but try to minimize use of Select/Activate
        For Each oShape In oSlide.Shapes
            ExecFlag = False ' Reset flag for each shape
            ' Handle Charts and Embedded Excel Objects
            If oShape.HasChart Then
                Set myChart = oShape.Chart
                myChart.ChartData.Activate 'Use Activate
                ExecFlag = True
            ElseIf oShape.Type = msoEmbeddedOLEObject Then
                Set Wb = oShape.OLEFormat.Object
                If TypeName(Wb) = "Workbook" Then
                    oShape.OLEFormat.DoVerb (2) 'Use Activate
                    ExecFlag = True
                End If
            End If
            ' Process Excel Objects (Charts or Embedded)
            If ExecFlag Then
                Set Wb = excelApp.ActiveWorkbook ' Get the active workbook
                ' "Fake" Step: Activate a Worksheet (with error handling)
                On Error Resume Next
                Set TempSheet = Wb.Worksheets(1) ' Try the first sheet
                If Not TempSheet Is Nothing Then
                    TempSheet.Activate
                Else
                    Set TempSheet = Wb.Sheets.Add ' Add a sheet if no sheets exist
                    TempSheet.Activate
                End If
                On Error GoTo 0
                '  Update Links, Modify Data, and Update Tables (with error handling)
                On Error Resume Next
                Wb.UpdateLink Name:=Wb.LinkSources ' Update links
                Wb.Worksheets("Data").Range("BZ1").Value = "AABBDED" ' Modify cell value
                Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana" ' Search/replace
                '  Update List Object Filters (Consolidated and Improved)
                 For Each wsName In Array("Data", "Sheet1")
                    For Each loName In Array("Data", "Table1")
                         ' Construct sheet and listobject names, and handle errors robustly
                         On Error Resume Next
                          With Wb
                               If .Worksheets(wsName) Is Nothing Then
                                  GoTo NextLO 'If worksheet doesn't exist, go to the next listobject
                               End If
                               If .Worksheets(wsName).ListObjects(loName) Is Nothing Then
                                  GoTo NextLO 'If listobject doesn't exist, go to the next listobject
                               End If
                               .Worksheets(wsName).ListObjects(loName).Range.AutoFilter Field:=1, Criteria1:="<>0"
                            End With
NextLO:
                        On Error GoTo 0
                    Next loName
                Next wsName
                On Error GoTo 0
                Wb.RefreshAll      ' Refresh all connections
                Wb.Close SaveChanges:=False ' Close without saving changes
                Set Wb = Nothing
                ' Add "Updated Data" Textbox
                Set Tb = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, oShape.Left, oShape.Top, 100, 25)
                With Tb
                    .Name = "Delete_" & oShape.Name
                    .Fill.ForeColor.RGB = RGB(255, 255, 0)
                    .TextFrame.TextRange.Text = "Updated Data"
                    .TextFrame.TextRange.Font.Size = 8
                    '.Select 'Consider if you really need to select.
                End With
                Set Tb = Nothing 'Clean up
            End If ' End If ExecFlag
        Next oShape
    Next oSlide
CleanUp:
    On Error Resume Next
    '## 13. Clean Up Excel Application
    If Not excelApp Is Nothing Then
        excelApp.DisplayAlerts = True
        excelApp.Quit ' Quit Excel
        Set excelApp = Nothing ' Release object
    End If
    On Error GoTo 0
    Exit Sub ' Use Exit Sub for normal termination
ErrorHandler:
    Dim errDesc As String
    errNum = Err.Number
    errDesc = Err.Description
    If errNum <> 0 Then
        MsgBox "Error in " & PROC_NAME & ":" & vbCrLf & "Error Number: " & errNum & vbCrLf & "Description:  " & errDesc, vbCritical, "Application Error"
    End If
    ' Resume CleanUp  ' Moved to before Exit Sub
    Resume CleanUp ' Ensure cleanup is executed
End Sub

[Aussiebear]

Thank you for your feedback.

[Aussiebear]

Hmmm... does this fix your issue?

Sub Chart___Testing_Revised_V8()
    ' Object Declarations
    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 Excel.Workbook or OLEObject
    Dim excelApp As Object      ' Excel.Application object
    Dim TempSheet As Object      ' Temporary worksheet object
    Dim Tb As Shape       ' Textbox Shape object
    '## Variable Declarations
    Dim answer As Integer
    Dim ExecFlag As Boolean
    Dim wsName As Variant     ' Changed to Variant as per user feedback
    Dim loName As Variant     ' Changed to Variant as per user feedback
    Dim errNum As Long
    ' Constants
    Const PROC_NAME As String = "Chart___Testing_Revised_V8" ' For error handling
    Const ERR_XL_APP_NOT_FOUND = 429 'Constant for Excel not found Error
    ' Main Procedure
    On Error GoTo ErrorHandler ' Enable error handling
    '  Get Presentation Object
    Set oPres = ActivePresentatio
    ' Prompt User for Confirmation
    answer = MsgBox( _
        "This macro will update linked data in all charts and embedded Excels." & vbCrLf & _
        "It will also update dynamic tables named 'Data'/'Table1' in 'Data'/'Sheet1' sheets." & vbCrLf & _
        "IMPORTANT: This macro does NOT work on GROUPED CHARTS." & vbCrLf & _
        "BACKUP YOUR PRESENTATION FILE BEFORE RUNNING THIS MACRO." & vbCrLf & "Continue?", _
        vbQuestion + vbYesNo + vbDefaultButton2, "WARNING: Data Update Macro" )
    ' Exit if User Cancels
    If answer = vbNo Then
        Exit Sub ' Use Exit Sub for a cleaner exit
    End If
     ' Get or Create Excel Application Object
    ' Attempt to get an existing instance.  If none exists, create a new one.
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    errNum = Err.Number
    On Error GoTo 0
    If errNum = ERR_XL_APP_NOT_FOUND Then 'Use constant
        Set excelApp = CreateObject("Excel.Application")
    ElseIf errNum <> 0 Then
        ' Handle other errors during GetObject.
        GoTo ErrorHandler
    End If
    ' Configure Excel Application
    excelApp.Visible = False       ' Run in the background
    excelApp.DisplayAlerts = False ' Suppress prompts
    ' Loop Through Slides and Shapes
    For Each oSlide In oPres.Slides
        oSlide.Select 'Potentially needed for .Activate, but try to minimize use of Select/Activate
        For Each oShape In oSlide.Shapes
            ExecFlag = False ' Reset flag for each shape
            ' Handle Charts and Embedded Excel Objects
            If oShape.HasChart Then
                Set myChart = oShape.Chart
                myChart.ChartData.Activate 'Use Activate
                ExecFlag = True
            ElseIf oShape.Type = msoEmbeddedOLEObject Then
                Set Wb = oShape.OLEFormat.Object
                If TypeName(Wb) = "Workbook" Then
                    ' Changed back to DoVerb as per user feedback
                    oShape.OLEFormat.DoVerb 1 ' 1 is typically the "Open" verb
                    ExecFlag = True
                End If
            End If
            ' Process Excel Objects (Charts or Embedded)
            If ExecFlag Then
                Set Wb = excelApp.ActiveWorkbook ' Get the active workbook
                ' "Fake" Step: Activate a Worksheet (with error handling)
                On Error Resume Next
                Set TempSheet = Wb.Worksheets(1) ' Try the first sheet
                If Not TempSheet Is Nothing Then
                    TempSheet.Activate
                Else
                    Set TempSheet = Wb.Sheets.Add ' Add a sheet if no sheets exist
                    TempSheet.Activate
                End If
                On Error GoTo 0
                ' Update Links, Modify Data, and Update Tables (with error handling)
                On Error Resume Next
                Wb.UpdateLink Name:=Wb.LinkSources ' Update links
                Wb.Worksheets("Data").Range("BZ1").Value = "AABBDED" ' Modify cell value
                Wb.Worksheets("Data").Range("A1:M50").Replace "Apple", "Banana" ' Search/replace
                ' Update List Object Filters (Consolidated and Improved)
                 For Each wsName In Array("Data", "Sheet1")
                    For Each loName In Array("Data", "Table1")
                        ' Construct sheet and listobject names, and handle errors robustly
                        On Error Resume Next
                        With Wb
                            If .Worksheets(wsName) Is Nothing Then
                                GoTo NextLO 'If worksheet doesn't exist, go to the next listobject
                            End If
                            If .Worksheets(wsName).ListObjects(loName) Is Nothing Then
                                GoTo NextLO 'If listobject doesn't exist, go to the next listobject
                            End If
                            .Worksheets(wsName).ListObjects(loName).Range.AutoFilter Field:=1, Criteria1:="<>0"
                        End With
                   NextLO:                   
                   On Error GoTo 0
                   Next loName
                Next wsName
                On Error GoTo 0
                Wb.RefreshAll      ' Refresh all connections
                Wb.Close SaveChanges:=False ' Close without saving changes
                Set Wb = Nothing    'Release
                Set TempSheet = Nothing 'Release
                ' Add "Updated Data" Textbox
                Set Tb = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, oShape.Left, oShape.Top, 100, 25)
                With Tb
                    .Name = "Delete_" & oShape.Name
                    .Fill.ForeColor.RGB = RGB(255, 255, 0)
                    .TextFrame.TextRange.Text = "Updated Data"
                    .TextFrame.TextRange.Font.Size = 8
                    .Select 'Consider if you really need to select.
                End With
                Set Tb = Nothing 'Clean up
            End If ' End If ExecFlag
        Next oShape
    Next oSlide
    CleanUp:
    On Error Resume Next
    '## 13. Clean Up Excel Application
    If Not excelApp Is Nothing Then
        excelApp.DisplayAlerts = True
        excelApp.Quit ' Quit Excel
        Set excelApp = Nothing ' Release object
    End If
    On Error GoTo 0
    Exit Sub ' Use Exit Sub for normal termination
ErrorHandler:
    Dim errDesc As String
    errNum = Err.Number
    errDesc = Err.Description
    If errNum <> 0 Then
        MsgBox "Error in " & PROC_NAME & ":" & vbCrLf & "Error Number: " & errNum & vbCrLf & _
        "Description:  " & errDesc, vbCritical, "Application Error"
    End If
    ' Resume CleanUp  ' Moved to before Exit Sub
    Resume CleanUp ' Ensure cleanup is executed
End Sub

[yurble_vn]

Hi AussieBear,

Many thank for your kind support...
but, V8 keep coming with Error: 424, Object Required (with or without Excel openning)...

V7 works fine for me..., i can stand with the Excel Window Pop Up...

regards
Yurble