Cette macro met à jour tous les liens sources de toutes les images liées qui se trouvent dans le sous-répertoire images (placé au même niveau que le document word)

 Sub majLiensI1()
    Call majLienImagesSuivant("images", "images")
End Sub

Sub majLienImagesSuivant(ByVal nomRepertoireGlobalImagesInitial, ByVal nomRepertoireGlobalImagesFinal)
  ' Ce programme s'inspire du pgrm AutoUpdate mis dans le forum
  ' https://www.msofficeforums.com/word/38722-word-fields-relative-paths-external-files.html
  '  créé par Paul Edstein (aka macropod) et publié
  '     dans http://windowssecrets.com/forums/showthread.php/154379-Word-Fields-and-Relative-Paths-to-External-Files
  Dim doc As Word.Document
  Dim oILShp As InlineShape
  ' s'appuie sur UpdateFields de XXX
  ' This routine sets the new path for external links, pointing them to the current folder.
  Dim Rng As Range, Fld As Field, Shp As Shape, iShp As InlineShape, i As Long
  Dim OldPath As String, NewPath As String, Parent As String, Child As String, StrTmp As String
  Dim leSeparateur As String
  Dim leSourceFullName, S1 As String
  Dim leSeparateurMac, leSeparateurPC As String
  Dim nbSepMac, nbSepPC As Integer
  Dim compteur As Integer

  leSeparateurMac = "/"
  leSeparateurPC = "\"
    
  #If Mac Then
        leSeparateur = leSeparateurMac
   #Else
        leSeparateur = leSeparateurPC
  #End If
  Set doc = ActiveDocument

  nbNiveauASauter = 0  'dans le cas 1
 
  For i = 0 To UBound(Split(ActiveDocument.Path, leSeparateur)) - nbNiveauASauter
    Parent = Parent & Split(ActiveDocument.Path, leSeparateur)(i) & leSeparateur
  Next i
  Child = ""
  NewPath = Parent & Child
  ' Strip off any trailing path separators.
  While Right(NewPath, 1) = leSeparateur
    NewPath = Left(NewPath, Len(NewPath) - 1)
  Wend
  NewPath = NewPath & leSeparateur
   
 compteur = 0
  For Each oILShp In ActiveDocument.InlineShapes
    If (Not oILShp.LinkFormat Is Nothing) Then
           leSourceFullName = oILShp.LinkFormat.SourceFullName
           S1 = leSourceFullName
           nbSepMac = OneCharCount(S1, leSeparateurMac)
           nbSepPC = OneCharCount(S1, leSeparateurPC)
                
       If (leSeparateur = leSeparateurMac) And (nbSepMac < nbSepPC) Then
               ' on doit convertir le SOurceFullName en format MAc
               ' le fichier provient à l'origine d'un PC
               leSourceFullName = Replace(leSourceFullName, leSeparateurPC, leSeparateurMac)
           Else
              If (leSeparateur = leSeparateurPC) And (nbSepPC < nbSepMac) Then
               'on doit convertir le SOurceFullName en format PC
               leSourceFullName = Replace(leSourceFullName, leSeparateurMac, leSeparateurPC)
           End If
    End If
    longueurSourceFullName = Len(leSourceFullName)
    longueurNomRepertoireGlobalImagesInitial = Len(nomRepertoireGlobalImagesInitial)
    sschemin = leSeparateur & nomRepertoireGlobalImagesInitial & leSeparateur
    pos1 = InStrRev(leSourceFullName, sschemin)
    If (pos1 > 0) Then
      'Apparemment le source pointe bien sur l'image
      'Feu vert pour la modification
      OldP1 = Left(leSourceFullName, pos1 - 1)
      OldP2 = Mid(leSourceFullName, pos1 + longueurNomRepertoireGlobalImagesInitial + 2, longueurSourceFullName)
               
      leNewSourceFullName = NewPath & nomRepertoireGlobalImagesFinal & leSeparateur & OldP2
      ' MsgBox (leNewSourceFullName)
      If (leSeparateur = leSeparateurMac) Then
        If (InStr(NewPath, "/Library/Containers/com.microsoft.Word/Data/") >= 1) Then
          'Apparemment, sous Mac, le nom du document est mis provisoirement dans /Library/containers/../Data
          leNewSourceFullName = Replace(leNewSourceFullName, "/Library/Containers/com.microsoft.Word/Data/", "/")
          ' MsgBox ("Pb de containers sous Mac")
          ' MsgBox (leNewSourceFullName)
    
        End If
      End If
      If leSourceFullName <> leNewSourceFullName Then
        ' MsgBox ("On change " & leNewSourceFullName)
        compteur = compteur + 1
        oILShp.LinkFormat.SourceFullName = leNewSourceFullName
        oILShp.LinkFormat.Update
        
        On Error Resume Next
           oILShp.LinkFormat.AutoUpdate = False
      End If
     End If 'pos1 > 0
   End If  'If (Not oILShp.LinkFormat Is Nothing)
  Next 'oILShp
  
  MsgBox "Vous avez changé " & compteur & " source(s) d'images liées"
End Sub
 
Function OneCharCount(ByVal str As String, ByVal chr As String) As Integer
    OneCharCount = Len(str) - Len(Replace(str, chr, ""))
End Function