Announcement

Collapse
No announcement yet.

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

Collapse
X
  • 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...

    Thanks!

    Code:
    Sub changeLinkTargets()
    Code:
    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
        DoEvents
        Next pptShape
    DoEvents
    Next pptSlide
    
    End Sub
Working...
X