Sub Remplacer()
Dim nom As String, texte As String, Wapp As Object, deb As Long
nom = "toto" 'nom du signet Word, à adapter
texte = Trim(Replace(TextBox1, vbCrLf, vbLf)) 'texte à ajouter
If texte = "" Then Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then MsgBox "Ouvrez le document Word !", 48: Exit Sub
Wapp.Visible = True
With Wapp.ActiveDocument
If .Path <> "" Then ThisWorkbook.FollowHyperlink .FullName 'force l'activation de Word
deb = .Bookmarks(nom).Start 'début du signet
If Err Then MsgBox "Le signet n'existe pas !", 48: GoTo 1
texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf 'encadrement par des renvois à la ligne
.Bookmarks(nom).Range.Text = texte 'remplace le texte contenu
.Bookmarks.Add nom, .Range(deb, deb + Len(texte) - 1) 'recrée le signet
End With
1 AppActivate Wapp.Caption 'si le document n'est pas sur le disque dur
End Sub