Sub ChangerLiens(ByVal Ancien As String, ByVal Nouveau As String)
Dim TA() As String, TN() As String, TLkSrc(), N As Long, Lien As String, _
TL() As String, PL As Long, P As Long, ÀChanger As Boolean
TA = Split(Replace(Ancien, "...", "…"), "\")
TN = Split(Replace(Nouveau, "...", "…"), "\")
If UBound(TA) <> UBound(TN) Then MsgBox UBound(TN) + 1 & _
" éléments spécifiés en remplacement de " & UBound(TA) + 1, _
vbCritical, "ChangerLiens": Exit Sub
For P = 0 To UBound(TA)
If TN(P) = "…" Xor TA(P) = "…" Then MsgBox "Code ""…"" incohérent position " & P + 1 _
& vbLf & "Nouveau = """ & TN(P) & """ pour """ & TA(P) & """.", _
vbCritical, "ChangerLiens": Exit Sub
Next P
TLkSrc = ThisWorkbook.LinkSources
For N = 1 To UBound(TLkSrc)
Lien = TLkSrc(N): TL = Split(Lien, "\"): PL = -1
ÀChanger = True
For P = 0 To UBound(TA)
If TA(P) = "…" Then
PL = P + UBound(TL) - UBound(TA)
Else: PL = PL + 1
If TA(P) <> "*" Then If TL(PL) <> TA(P) Then ÀChanger = False: Exit For
If TN(P) <> "*" Then TL(PL) = TN(P)
End If: Next P
If ÀChanger Then ChangerLien Lien, Join(TL, "\")
Next N
End Sub
Sub ChangerLien(ByVal Ancien As String, ByVal Nouveau As String)
If Ancien = Nouveau Then Exit Sub
If MsgBox("Voulez vous changer le lien """ & Ancien & """ en """ & Nouveau & """ ?", _
vbYesNo + vbExclamation, Me.Name) = vbNo Then Exit Sub
On Error Resume Next
ThisWorkbook.ChangeLink Ancien, Nouveau, xlLinkTypeExcelLinks
If Err Then MsgBox "Err " & Err & " en tentant de changer le lien." _
& vbLf & Err.Description, vbCritical, Me.Name
End Sub