Option Explicit
Private Sub Workbook_Open()
Dim Liens, CheminActuel As String, L&, P&, AncLien As String, NouvLien As String
Liens = ThisWorkbook.LinkSources
If IsEmpty(Liens) Then Exit Sub
CheminActuel = ThisWorkbook.Path & "\"
For L = 1 To UBound(Liens)
AncLien = Liens(L)
P = InStrRev(AncLien, "\")
NouvLien = CheminActuel & Mid$(AncLien, P + 1)
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