VBA code: runtime error 429 (linking PPT chart to new excel file)

[notacoderbytrade]

Hello,

I am new to VBA and experiencing an issue with a bit of code I pulled from a resolved thread. I will explain what I am trying to use the code for and then explain my issue and post the code. Thank you for your help, any advice is appreciated.

I first needed a code to extract the data from PowerPoint charts that have a broken or missing link to the source Excel file. I found a code for that task and I have been able to get that to work nicely. I am able to extract the data from various PowerPoint charts that does not allow a user to access/edit the chart data due to missing links. The issue I am having is with the second macro I am trying to implement. I am now trying to use a code that takes the data I just extracted and links the data in the excel file to the chart with the broken link.

I found a code that is supposed to allow the user to re-link a chart to another source file, but this is where I am having issues. When I run the macro I receive this error:

"runtime error 429
activex component can't create object"

I thought the error was due to the fact that the chart has broken links / a source file that cannot be accessed, but I receive the same error even when I try the macro on a chart that has working links / data that can be easily found and edited with PowerPoint

The debugger is highlighting one line of code so far, but I'm not sure what the issue is. Here is the line highlighted in yellow by VBA:

"For Each sld In ActivePresentation.Slides"

I have another code I found that is giving me the same issue. When I run the macro using either code, it prompts me to brows and select a new file to be replaced as the source file. Once I select the excel file, the macro gives me the same error message.

I am using Excel and PowerPoint 2010. Thank you for your help!


Code generating the error message:

Sub Relink_Data_Macro_2()    Dim sld As Slide
    Dim sh As Shape
    Dim ExcelFileNew
    Dim exl As Object
    Set exl = CreateObject("Excel.Application")
     
     'Open a dialog box to promt for the new source file.
    ExcelFileNew = exl.Application.GetOpenFilename(, , "Select Excel File")
    Call stripPath(ExcelFileNew, filenameNew)
     
For Each sld In ActivePresentation.Slides
    For Each sh In sld.Shapes
        If sh.Type = msoLinkedOLEObject Then
            With sh.LinkFormat
                LinkOld = .SourceFullName
                Call stripReference(LinkOld, fullpathOld)
                Call stripPath(fullpathOld, filenameOld)
                 'LinkNew = Replace(LinkOld, filenameOld, filenameNew)
                LinkNew = Replace(LinkOld, fullpathOld, ExcelFileNew)
                SourceFullName = LinkNew
                 'Call showStrings(ExcelFileNew, filenameNew, LinkOld, fullpathOld, filenameOld, LinkNew)
            End With
        End If
    Next sh
Next sld
End Sub
 '
Sub stripPath(fullPath, filename)
     
     'This will take c:\folder\workbook.xlsx* and provide workbook.xlsx*
    Dim filenamePosition As Long
     
    filenamePosition = InStrRev(fullPath, "\")
    filename = Mid(fullPath, filenamePosition + 1, Len(fullPath) - filenamePosition)
     
End Sub
 '
Sub stripReference(fullReference, filename)
     
     'This will take *workbook.xls!Graphs![workbook.xls]Graphs Chart 1 and provide *workbook.xls
    Dim referencePosition As Long
     
    referencePosition = InStr(1, fullReference, "!")
    filename = Left(fullReference, referencePosition - 1)
     
End Sub
 '
Sub showStrings(ExcelFileNew, filenameNew, LinkOld, fullpathOld, filenameOld, LinkNew)
     
     'This is just a debugging function to display the variables
    MsgBox ("ExcelFileNew: " & ExcelFileNew & vbNewLine _
    & "filenameNew: " & filenameNew & vbNewLine _
    & "LinkOld: " & LinkOld & vbNewLine _
    & "fullpathOld: " & fullpathOld & vbNewLine _
    & "filenameOld: " & filenameOld & vbNewLine _
    & "LinkNew: " & LinkNew)
     
End Sub

This is the code I found for my first macro, which is working well for me. I am posting the code in the hopes it is useful in diagnosing my error or another user finds the code useful for their own purposes.

Sub PPChartDataToExcel()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Data")
wb.Activate
ws.Select
Dim PPApp As Object ' As PowerPoint.Application
Dim PPPres As Object ' As PowerPoint.Presentation
Dim PPSlide As Object ' As PowerPoint.Slide


Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation


Set cht = PPPres.Slides(1).Shapes(1).Chart


Dim NumberOfRows As Integer
Dim X As Object
Counter = 2


' Calculate the number of rows of data.
NumberOfRows = UBound(cht.SeriesCollection(1).Values)


ws.Cells(1, 1) = "X Values"


' Write x-axis values to worksheet.
With ws
    .Range(.Cells(2, 1), .Cells(NumberOfRows + 1, 1)) = Application.Transpose(cht.SeriesCollection(1).XValues)
End With


' Loop through all series in the chart and write their values to
' the worksheet.
For Each X In cht.SeriesCollection
    ws.Cells(1, Counter) = X.Name
    
    With ws
        .Range(.Cells(2, Counter), .Cells(NumberOfRows + 1, Counter)) = Application.Transpose(X.Values)
    End With
    
    Counter = Counter + 1
Next
    
End Sub

 

[Dryver14]

try

For Each sld In ActivePresentation.Slide.shapes

Also anywhere I look Activepresentation.slide is followed by () so it appears you need to place the slide number there

For each sld in ActivePresentation.Slide(1).shapes

 

[notacoderbytrade]

Thank you for the suggestion, but unfortunately I'm receiving the same error message. I thought maybe the issue had to do with not defining what type of document to reference (e.g. a powerpoint doc) but that doesn't appear to make a difference. Again, I don't know what I'm talking about because I'm new to VBA.

Dim PPApp As Object ' As PowerPoint.Application
    Dim PPPres As Object ' As PowerPoint.Presentation
    Dim PPSlide As Object ' As PowerPoint.Slide


    Set PPApp = GetObject(, "Powerpoint.Application")
    Set PPPres = PPApp.ActivePresentation




    Set cht = PPPres.Slides(1).Shapes(1).Chart

 

[notacoderbytrade]

I meant to reply to your message, but instead I posted below. Just shows how new I am to all of this.