Microsoft 365 problème liens excel

[cmdavid]

Bonjour a tous,
j'ai un dossier (A) contenant des fichiers excel (1 et 2) qui ont des liens entre eux. lorsque je fais une copie du dossier, les liens des fichiers 1 et 2 reste ceux des fichiers du dossier A.
comment faire pour lorsque je fais des copies, les liens soient ceux des fichiers excel du nouveau dossier?
un grand merci pour votre aide

 

[Dranreb]

Bonjour.
D'accord, j'avais pour ma part mal compris le problème.
Donc si je comprends bien il est impossible de deviner où ont été déplacés les classeurs liés ? Dans ce cas je crains qu'on ne puisse rien automatiser, sauf à spécifier quelque part les liens à changer. Dans ce cas le plus simple c'est d'utiliser la commande Modifier les liaisons, groupe Connexions du menu Données.

 

[chris]

Bonjour à tous

Tu ne décris pas la même chose qu'au #4 concernant l'arborescence donc difficile à suivre d'autant que tu évoques deux dossier AB dont un est copié...

et pour couronner le tout, tes liens actuels pointent sur le bureau, donc sans doute une copie sans rapport avec la réalité...

Si comme décrit au #4 les fichiers autres que T-BASE sont, soit dans le même dossier, soit dans un sous-dossier du dossier où est T-BASE, le code que j'ai donné au #9 fonctionne parfaitement si on déplace ou copie tout le dossier...

 

[Dranreb]

Je donne quand même à tout hasard une autre version de ma procédure.

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

Elle permettrait seulement de changer les liens qui n'ont pas la même racine que le classeur.