You should be able to work on this I think.
Sub fixLinks()
Dim osld As Slide, oshp As Shape
Dim strpath As String
strpath = InputBox("Enter the new path", "Edit Path", getexisting(ActivePresentation))
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then
If oshp.OLEFormat.ProgID Like "*Excel*" Then
oshp.LinkFormat.SourceFullName = strpath
oshp.LinkFormat.Update
End If
End If
Next: Next
End Sub
Function getexisting(opres As Presentation) As String
'this finds the first old link as a prompt
Dim osld As Slide, oshp As Shape
For Each osld In opres.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then
If oshp.OLEFormat.ProgID Like "*Excel*" Then
getexisting = oshp.LinkFormat.SourceFullName
Exit Function
If your need are more than this and you cannot edit yourself then as this is obviously a commercial enterprize I'm afraid you will have to hire me!
|