Mon fichier Word contient des liens vers d'autres fichiers. Lorsque je déplace les fichiers, Word ne retrouve plus les liens, car ils sont en absolu. Comment rendre ces liens relatifs ?
Cette question revient souvent, et elle est fonction des versions de Word.
Pour commencer, si cela est possible, rangez tous les fichiers dans le même dossier. Dossiers parents/enfants acceptés. Pour déplacer l'un ou l'autre des fichiers sans rompre le lien, déplacez le dossier complet.
Si vous rencontrez des problèmes, voici une macro, écrite par Macropod, MVP Word américain, qui met à jour automatiquement, à l'ouverture du fichier, les liens vers les autres fichiers.
Option Explicit
' Macro qui met à jour automatiquement des liens vers d'autres fichiers
' créée par macropod. Posted at:
' http://lounge.windowssecrets.com/index.php?showtopic=670027
Dim TrkStatus As Boolean ' suivi des modifications
Dim Pwd As String ' variable pour récupérer les mdp des documents protégés
Dim pState As Boolean ' état docs protégés
Sub AutoOpen()
' Cette routine s'exécute à l'ouverture du document
' It calls on the others to do the real work.
' Prepare the environment.
With ActiveDocument
' mot de passe doc
Pwd = ""
' Initialise l'état protection
pState = False
' si le document est protégé, on déprotège
If .ProtectionType <> wdNoProtection Then
' met à jour l'info protection
pState = True
' déprotège
.Unprotect Pwd
End If
Call MacroEntry
Call UpdateFields
Selection.HomeKey Unit:=wdStory
' nettoie et termine
Call MacroExit
' si le doc était protégé, on reprotège, en préservant le contenu des champs de formulaire
If pState = True Then .Protect wdAllowOnlyFormFields, Noreset:=True, Password:=Pwd
.Saved = True
End With
End Sub
Private Sub MacroEntry()
' enregistre le statut de modifications, et le switche temporairement
With ActiveDocument
TrkStatus = .TrackRevisions
.TrackRevisions = False
End With
Application.ScreenUpdating = False
End Sub
Private Sub MacroExit()
' Restore original statuts modifs
ActiveDocument.TrackRevisions = TrkStatus
Application.ScreenUpdating = True
End Sub
Private Sub UpdateFields()
'définit le nouveau chemin pour les liens externes, les dirigeant vers le dossier en cours.
Dim oRng As Range, oFld As Field, i As Integer
Dim OldPath As String, NewPath As String, Parent As String, Child As String
' définit le nouveau chemin (fonction de l'arborescence)
For i = 0 To UBound(Split(ActiveDocument.Path, "\")) - 0
Parent = Parent & Split(ActiveDocument.Path, "\")(i) & "\"
Next i
'cas de dossiers enfants
Child = ""
NewPath = Parent & Child
' traite les séparateurs
While Right(NewPath, 1) = "\"
NewPath = Left(NewPath, Len(NewPath) - 1)
Wend
' passer par toutes les couches du doc (yc en-têtes et pdp)
With ThisDocument
For Each oRng In .StoryRanges
For Each oFld In oRng.Fields
With oFld
' zappe les champs qui n'ont pas de liens vers fichiers externes
If .Type = wdFieldHyperlink Or .Type = wdFieldImport _
Or .Type = wdFieldInclude Or .Type = wdFieldIncludePicture _
Or .Type = wdFieldIncludeText Or .Type = wdFieldLink Or .Type = wdFieldRefDoc Then
OldPath = GetPath(.LinkFormat.SourceFullName)
' Remplacer le lien vers le fichier externe, si diffèrent
If OldPath <> NewPath Then .LinkFormat.SourceFullName = _
Replace(.LinkFormat.SourceFullName, OldPath, NewPath)
End If
End With
Next oFld
Next oRng
End With
End Sub
Function GetPath(StrPath As String)
While Right(StrPath, 1) <> "\"
StrPath = Left(StrPath, Len(StrPath) - 1)
Wend
StrPath = Left(StrPath, Len(StrPath) - 1)
GetPath = StrPath
End Function