Excel Macro to change powerpoint links

[seenai]

Hi,

I have a Powerpoint File, which has many Excel linked linked Charts. Now the folder name and Excel File names are changed.

I need a macro to
a) list all the links of the powerpoint file.
b) I want to update the new link.

Help me by a macro to do so.
Thanks in advance.

Regards,

B.Srinivasa Rao

 

[Worf]

Hi

This is the first part, a PowerPoint code that lists the links. According to your title, do you prefer to run this from Excel?

' PowerPoint module
Sub PowerPointLinks()
Dim pptPres As Presentation, pptSlide As Slide, pptShape As Shape, s$
Set pptPres = ActivePresentation
s = ""
For Each pptSlide In pptPres.Slides
    For Each pptShape In pptSlide.Shapes
        If pptShape.Type = msoLinkedPicture Or pptShape.Type = msoLinkedOLEObject Then _
        s = s & pptShape.LinkFormat.SourceFullName & vbLf
    Next
Next
MsgBox s
pptPres.UpdateLinks
End Sub

 

[seenai]

Hi

This is the first part, a PowerPoint code that lists the links. According to your title, do you prefer to run this from Excel?

' PowerPoint module
Sub PowerPointLinks()
Dim pptPres As Presentation, pptSlide As Slide, pptShape As Shape, s$
Set pptPres = ActivePresentation
s = ""
For Each pptSlide In pptPres.Slides
    For Each pptShape In pptSlide.Shapes
        If pptShape.Type = msoLinkedPicture Or pptShape.Type = msoLinkedOLEObject Then _
        s = s & pptShape.LinkFormat.SourceFullName & vbLf
    Next
Next
MsgBox s
pptPres.UpdateLinks
End Sub

Hi,

Thanks for your response.

Yes. I want to update from Excel Macro.

a) I will provide Path of PPT --> Excel Macro to list the Links in PPT
b) I will enter the New File Path in Next Column --> Macro to update the Links.

Hope I am clear.

 

[Worf]

This version is an Excel macro that lists the links starting at cell L20, and updates them with the information entered at column M, starting at M20.
The PowerPoint file path is retrieved from cell K18.

' Excel module
Dim obppt As Object, pres As Presentation, sl As Slide, sh As PowerPoint.shape, r As Range

Sub ListLinks()
Set obppt = CreateObject("PowerPoint.Application")
obppt.Visible = True
obppt.Presentations.Open CStr([k18])
Set pres = obppt.ActivePresentation
Set r = [L20]
For Each sl In pres.Slides
    For Each sh In sl.Shapes
        If sh.Type = msoLinkedPicture Or sh.Type = msoLinkedOLEObject Then
            r = sh.LinkFormat.SourceFullName
            Set r = r.Offset(1)
        End If
    Next
Next
UpdateLinks
End Sub

Sub UpdateLinks()
Dim result
For Each sl In pres.Slides
    For Each sh In sl.Shapes
        If sh.Type = 11 Or sh.Type = 10 Then
            result = WorksheetFunction.VLookup(sh.LinkFormat.SourceFullName, _
            [L20].CurrentRegion, 2, False)
            If Len(result) > 0 Then sh.LinkFormat.SourceFullName = result
        End If
Next sh, sl
pres.UpdateLinks
End Sub