Option Explicit

Sub ModifierInsertions()
' Cette macro remplace du texte dans les insertions d'un modèle dotm
Const ancienTexte As String = "Company OldOne"
Const nouveauTexte As String = "Company NewOne"

Dim DocSource As Template
Dim Resultat As Document
Dim insertion As AutoTextEntry
Dim Correction As AutoCorrectEntry
Dim bloc As Variant
Dim i As Integer, p As Long
Dim texte As String
Dim texteM As String
With Dialogs(wdDialogFileOpen)
    .name = "*.dotm"
    .ReadOnly = False
    If .Display <> -1 Then
      MsgBox "Abandon : pas de modèle indiqué"
      Exit Sub
    End If
    .Execute
End With
Set DocSource = ActiveDocument.AttachedTemplate

' Recopie les insertions actuelles dans un nouveau document Word
Set Resultat = Documents.Add
Resultat.Range.InsertAfter vbCrLf & " > > > > > > > Liste des Autotext  a " & vbCrLf & vbCrLf
With DocSource
For i = 1 To .AutoTextEntries.count
  Set insertion = .AutoTextEntries(i)
  texte = insertion.Value
  Resultat.Range.InsertAfter i & " original : " & insertion.name & vbTab & texte & vbCrLf
  p = InStr(1, texte, ancienTexte)
  If p > 0 Then 'le texte recherché existe, le remplacer
    texteM = Left(texte, p - 1) & nouveauTexte & Mid(texte, p + Len(ancienTexte))
    .AutoTextEntries(i).Value = texteM
    Resultat.Range.InsertAfter i & " modifié : " & insertion.name & vbTab & .AutoTextEntries(i).Value & vbCrLf
  End If
Next i
End if