Macro pour changer un éléments dans un lien

Bonjour à tous !

Je cherchais une macro VBA pour changer un numéro de dossier dans un fichier avec liaisons en utilisant un message Inbox.

Je vais tenter de vous expliquer plus clairement dans chaque lien dans le fichier ci-joint il y a le nom du fichier dans l'exemple : "COMPT2122.xls". Il y aurait pas une méthode pour changer automatiquement le numéro de dossier 2122 par un Inbox. Genre je mets le numéro de dossier dans un Inbox et pouf automatiquement tout les numéros 2122 des liens sont se mette à jour automatiquement.

Je vous remercie par avance pour votre aide.

Bonjour,

Proposition de code

Sub modif_liaison()

    Dim demande, nouv_liaison As String
    Dim dossiers() As String
    Dim liaisons()

    '....... demande changement dossier ............................
    demande = InputBox("Entrer ancien n°dossier et nouveau n°dossier séparés par ;", "Demande changement n°dossier")
    dossiers = Split(demande, ";")
    réponse = MsgBox("Ancien n°dossier = " & dossiers(0) & " et Nouveau n° dossier = " & dossiers(1), vbYesNo, "Demande changement n°dossier")
    If réponse = vbNo Then Exit Sub

    '....... mise à jour liens .....................................
    Application.DisplayAlerts = False
    liaisons = ActiveWorkbook.LinkSources(xlExcelLinks)
    For i = 1 To UBound(liaisons)
        nouv_liaison = Replace(liaisons(i), dossiers(0), dossiers(1))
        ActiveWorkbook.ChangeLink Name:=liaisons(i), NewName:=nouv_liaison, Type:=xlExcelLinks
    Next

End Sub

thev a écrit :

Bonjour,

Proposition de code

Sub modif_liaison()

    Dim demande, nouv_liaison As String
    Dim dossiers() As String
    Dim liaisons()

    '....... demande changement dossier ............................
    demande = InputBox("Entrer ancien n°dossier et nouveau n°dossier séparés par ;", "Demande changement n°dossier")
    dossiers = Split(demande, ";")
    réponse = MsgBox("Ancien n°dossier = " & dossiers(0) & " et Nouveau n° dossier = " & dossiers(1), vbYesNo, "Demande changement n°dossier")
    If réponse = vbNo Then Exit Sub

    '....... mise à jour liens .....................................
    Application.DisplayAlerts = False
    liaisons = ActiveWorkbook.LinkSources(xlExcelLinks)
    For i = 1 To UBound(liaisons)
        nouv_liaison = Replace(liaisons(i), dossiers(0), dossiers(1))
        ActiveWorkbook.ChangeLink Name:=liaisons(i), NewName:=nouv_liaison, Type:=xlExcelLinks
    Next

End Sub

Merci beaucoup