Change Link Excel sheet - graph object Powerpoint VBA

Question

I am facing troubles with VBA coding.

I have an excel file with various sheets with data and graphs. These graphs are linked to a Powerpoint (graphs have been copied and paste "with link" as objects).

The issue, is that I now have a huge Powerpoint of more than 130 slides with about 18 graphs on each slide... So more than 2000 graphs.

I would like to change the name of my sheets and also to duplicate some slides to populate the graphs with filtered data.

My issue: - If changing the sheet name, of course the link is broken. Updating everything by hand with the UI is just impossible; - When duplicating a slide in PowerPoint, the graphs are still linked to the same Excel sheet as the original slide - the only way to change the link is to delete all graphs, duplicate the sheet in Excel - populating with new data - copying-pasting with link again each graph one by one into PowerPoint.

I have tried to use a macro but... it changes the whole address of the link, deleting all sheets information. Is there a way to modifiy the hard address but keeping the same excel file - only changing the sheet?

Here is what I am trying to use to replace the sheet "T3" by the sheet "100s". The macro runs without error but then all the objects are replaced by a copy of the WHOLE "100s" worksheet from my excel file :(

 Sub EditPowerPointLinks()

Dim oldFilePath As String
Dim newFilePath As String
Dim pptPresentation As Presentation
Dim pptSlide As Slide
Dim pptShape As Shape

'The old file path as a string (the text to be replaced)
oldFilePath = "\\Server\01xxxx\xxx\xx\X 4.xlsx!T3"

'The new file path as a string (the text to replace with)
newFilePath = "\\Server\01xxxx\xxx\xx\X 4.xlsx!100s"

'Set the variable to the PowerPoint Presentation
Set pptPresentation = ActivePresentation

'Loop through each slide in the presentation
For Each pptSlide In pptPresentation.Slides

    'Loop through each shape in each slide
    For Each pptShape In pptSlide.Shapes

        'Find out if the shape is a linked object or a linked picture
        If pptShape.Type = msoLinkedPicture Or pptShape.Type _
        = msoLinkedOLEObject Then

            'Use Replace to change the oldFilePath to the newFilePath
            pptShape.LinkFormat.SourceFullName = Replace(LCase _
            (pptShape.LinkFormat.SourceFullName), LCase(oldFilePath), newFilePath)

        End If
    Next
Next

'Update the links
pptPresentation.UpdateLinks


End Sub

Would anyone have an idea on how to change only the sheet name and keeping all the object names after?

Thanks a lot, Arthur

Please show us an example of what the entire pptShape.LinkFormat.SourceFullname string looks like. — Steve Rindsberg
Please don't append solved to the title. Instead post a solution and mark that as accepted. This will tell others that the question has been solved. Please take the tour for more info. — Bugs

Arthur Arthur · Accepted Answer · 2017-11-28T10:02:45

In fact, the formula works fine. The replacement of link didn't work because in the original sheet that I copied, the first object in the selection pane was Graph 3. When copying the sheet, Excel automatically tries to make it start at 1 so Graph 3 became Graph 1. Then, when replacing the links, the graphs didn't match.

To make this formula work, make sure in the Selection Pane in Excel that your graphs are named the same way between the original sheet and the new one.

Change Link Excel sheet - graph object Powerpoint VBA

1 Answers