Change links from Power Point to new Excel file

[Celtih]

Hey all
Do anyone know how to solve the following problem. I am not very experienced in VBA coding, so i will try to explain it as simple as I can.

Problem:
I have a template of a PowerPoint (X) that links to a template of a Excel file (A). The links are to charts/graphs.
When I copy X to a new PowerPoint (Y) and copy A to a new Excel file (B), I want to update the links from Y (that's still linking to A) to B.

The excel files and PowerPoint files are located in different folders.
Excel files: X:\Customer\2015\Graph (A.xlsx) and (B.xlsx)
PowerPoint: X:\Customer\2015\Reports (X.pptx) and (Y.pptx)

It is about 300 links and I am going to do it more than once, so it would be terrible if I had to do i manually.

I hope someone can help

[John Wilson]

It should be possible but it will help if you post a couple of examples of the original link paths and the desired new link path.

[Celtih]

Yes I will try:
Original link Path is the following:
X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\03 Halloween\05 Grafikker
The file name in that folder that is PowerPoint is linked to is "Grafikker Halloween 2015".

The new path could be the following:
X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\04 Jul\05 Grafikker
The file name in that folder is "Grafikker Jul 2015"

The PowerPoint have around 300 links to the Excel file.
An examples for two specifics graph thats links:
X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\03 Halloween\05 Grafikker\Grafikker Halloween 2015.xlsx!Segmenter på uge
and
X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\03 Halloween\05 Grafikker\Grafikker Halloween 2015.xlsx!Region

The new links for the two examples should be:
X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\04 Jul\05 Grafikker\Grafikker Jul 2015.xlsx!Segmenter på uge
And
X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\04 Jul\05 Grafikker\Grafikker Jul 2015.xlsx!Region

Is this what you meant?

[John Wilson]

You might need to experiment a little but something like this should work:

Sub fixlinks()

Dim oshp As Shape
Dim osld As Slide
 ' I may have misunderstood what needs changing so alter if required
Const replacethis As String = "03 Halloween\05 Grafikker\Grafikker Halloween 2015.xlsx"
Const replacewith As String = "04 Jul\05 Grafikker\Grafikker Jul 2015.xlsx"
On Error Resume Next
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.LinkFormat.SourceFullName Like "X:\Analytics and Insight\_Kunder\Tivoli\2015\Exit\*" Then
oshp.LinkFormat.SourceFullName = Replace(oshp.LinkFormat.SourceFullName, replacethis, replacewith)
oshp.LinkFormat.Update
End If
Next oshp
Next osld


End Sub

[Celtih]

It works!!!
I very much appreciate your help