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