Option Explicit
Private Sub Workbook_Open()
Dim Liens, CheminActuel As String, ArbClas() As String, ArbLien() As String, L&, P&, AncLien As String, NouvLien As String
Liens = ThisWorkbook.LinkSources
If IsEmpty(Liens) Then Exit Sub
CheminActuel = ThisWorkbook.Path
ArbClas = Split(CheminActuel, "\")
For L = 1 To UBound(Liens)
AncLien = Liens(L)
ArbLien = Split(AncLien, "\")
For P = 0 To UBound(ArbClas): ArbLien(P) = ArbClas(P): Next P
P = InStrRev(AncLien, "\")
NouvLien = Join(ArbLien, "\")
If NouvLien <> AncLien Then
If MsgBox("Le lien suivant doit-il être rectifié en celui indiqué en dessous ?" _
& vbLf & AncLien & vbLf & NouvLien, vbYesNo, "Correction liens externes") = vbYes Then
On Error Resume Next
ThisWorkbook.ChangeLink Name:=AncLien, NewName:=NouvLien, Type:=xlExcelLinks
If Err Then MsgBox "Err." & Err & " en tentant de changer le lien." _
& vbLf & Err.Description, vbCritical, "Correction liens externes"
On Error GoTo 0
End If
End If
Next L
End Sub