Sub ModifierWord()
'---cocher la référence Microsoft Word xx.x Object Library---
Dim Appli As Word.Application, WordDoc As Word.Document
Dim s As Object, pos As Long
On Error Resume Next
Set Appli = GetObject(, "Word.Application")
Set WordDoc = Appli.Documents("Doc1.doc")
If WordDoc Is Nothing Then MsgBox "'Doc1.doc' est fermé !": Exit Sub
Set s = WordDoc.Bookmarks(ActiveCell)
If s Is Nothing Then MsgBox "Signet inexistant !": Exit Sub
On Error GoTo 0
WordDoc.Activate
s.Select
Appli.Options.ReplaceSelection = True
Appli.Selection.TypeText ActiveCell(1, 2)
pos = Appli.Selection.Range.End
Set s = WordDoc.Range(pos - Len(ActiveCell(1, 2)), pos)
WordDoc.Bookmarks.Add ActiveCell, s
s.Select 'facultatif
End Sub