Sub ChangerLiaisonsOLElinked()
'### Constante à adapter (nouveau chemin et/ou nouveau nom du classeur source) ###
Const NEW_PATH As String = "c:\1111base PPT.xls"
'#################################################################################
Dim SL As Slide
Dim SH As Shape
Dim LF As LinkFormat
Dim A$
Dim PathLink$
Dim ClasseurSource$
Dim OleObjectRefer$
Dim NewClasseur$
'---
For Each SL In ActivePresentation.Slides
For Each SH In SL.Shapes
If SH.Type = msoLinkedOLEObject Then
Set LF = SH.LinkFormat
'--- Source actuelle ---
A$ = LF.SourceFullName
'°°° Le chemin du classeur source °°°
PathLink$ = Mid(A$, 1, InStr(1, A$, "!") - 1)
'°°° Le classeur source °°°
If InStr(1, A$, "[") > 0 Then
ClasseurSource$ = Mid(A$, InStr(1, A$, "[") + 1)
ClasseurSource$ = Mid(ClasseurSource$, 1, InStr(1, ClasseurSource$, "]") - 1)
End If
'°°° L'objet source (graphique, tableau, ...) °°°
OleObjectRefer$ = Mid(A$, Len(PathLink$) + 1)
'--- Nouvelle source (classeur source et objet source) ---
If InStr(1, A$, "[") > 0 Then
NewClasseur$ = Mid(NEW_PATH, InStrRev(NEW_PATH, "\") + 1)
OleObjectRefer$ = Replace(OleObjectRefer$, ClasseurSource$, NewClasseur$)
End If
LF.SourceFullName = NEW_PATH & OleObjectRefer$
LF.Update
End If
Next SH
Next SL
End Sub