Excel, Base de données pour compléter des documents Word

Sub AlimenterWord()
Dim WApp As Object, doc As Object, nom As Name
On Error Resume Next 'si des noms ne correspondent pas à des signets
Set WApp = GetObject(, "Word.Application")
For Each doc In WApp.documents
    For Each nom In ThisWorkbook.Names
        doc.bookmarks(nom.Name).Range = Evaluate(nom.Name)
Next nom, doc
End Sub

Sub AlimenterWord()
Dim WApp As Object, doc As Object, nom As Name, bm As Object, pos&, txt$
On Error Resume Next 'si des noms ne correspondent pas à des signets
Set WApp = GetObject(, "Word.Application")
For Each doc In WApp.documents
    For Each nom In ThisWorkbook.Names
        Set bm = Nothing
        Set bm = doc.Bookmarks(nom.Name)
        If Not bm Is Nothing Then
            pos = bm.Range.Start
            txt = ""
            txt = Evaluate(nom.Name).Text
            bm.Range.Text = txt
            doc.Bookmarks.Add Name:=nom.Name, Range:=doc.Range(pos, pos + Len(txt)) 'rétablit le signet
        End If
Next nom, doc
End Sub