No announcement yet.

PPT VBA code to link all charts/object to new source/location in different computer

  • Filter
  • Time
  • Show
Clear All
new posts

  • PPT VBA code to link all charts/object to new source/location in different computer

    Hey everybody,

    I am stuck with a project I am working on and would be more than grateful to get some help from someone with experience..

    I have a PowerPoint file/report with graphs & macro-enabled worksheet objects, both linked to a specific Excel file as a source.

    I want to share these 2 files (Excel + PowerPoint) to my colleagues so they can generate PPT reports themselves when updating the Excel, when all the graphs & objects need to be re-linked to the matching Excel file that was sent to them.

    As I want to create that connection before I send the files (as the source name can be changed), I created a folder with the same name/location as it will be in my colleague's computer, so when I send him the files, he doesn't have to do anything.

    I have a VBA code that I found, I tried it and ran it on my computer, but we I sent it to my colleague, only the charts were connected and not the macro-enabled worksheet objects.

    Is there something we can do? Maybe this code isn't the best approach...


    Sub changeLinkTargets()
    Dim pptSlide As Slide
    Dim pptShape As Shape
    Dim oldString As String
    oldString = "C:\Users\Avi\Report1.xlsm"
    Dim newString As String
    newString = "C:\John\Tool\Report1.xlsm"
    For Each pptSlide In ActivePresentation.Slides
        For Each pptShape In pptSlide.Shapes
            If pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedPicture Or pptShape.Type = msoChart Then
                With pptShape.LinkFormat
                    If InStr(1, UCase(.SourceFullName), UCase(oldString)) Then
                        .SourceFullName = Replace(.SourceFullName, oldString, newString)
                    End If
                End With
            End If
        Next pptShape
    Next pptSlide
    End Sub