Option Explicit
Private Sub Workbook_Open()
Dim TSplChm() As String, TLkSrc(), N As Long, AncLien As String, _
PMax As Long, P As Long, TSplL() As String, NouvLien As String
TSplChm = Split(Me.Path, "\")
On Error Resume Next
TLkSrc = Me.LinkSources
If Err Then Exit Sub
On Error GoTo 0
For N = 1 To UBound(TLkSrc)
AncLien = TLkSrc(N)
TSplL = Split(AncLien, "\")
P = UBound(TSplL) - 1: PMax = UBound(TSplChm): If PMax > P Then PMax = P
For P = 1 To PMax: TSplL(P) = TSplChm(P): Next P
NouvLien = Join(TSplL, "\")
If NouvLien <> AncLien Then
If MsgBox("Lien """ & AncLien & """ ? Curieux !" _
& vbLf & "Plutôt """ & NouvLien & """ ! Voulez vous changer ?", _
vbYesNo + vbExclamation, "Ouverture " & Me.Name) = vbYes Then
On Error Resume Next
Me.ChangeLink AncLien, NouvLien, xlLinkTypeExcelLinks
If Err Then MsgBox "Err " & Err & " en tentant de changer le lien." _
& vbLf & Err.Description, vbCritical, "Ouverture " & Me.Name
On Error GoTo 0: End If: End If: Next N
End Sub