Dim wApp As Object, oDoc As Object, d As Object, mes As String
On Error Resume Next
Set wApp = GetObject(, "Word.Application") 'si Word est déjà ouvert
On Error GoTo 0
If wApp Is Nothing Then Set wApp = CreateObject("Word.Application")
wApp.Visible = True
Set oDoc = wApp.Documents.Add(ThisWorkbook.Path & "\" & "DOCAUTO01-CourrierDevis.docx")
oDoc.Bookmarks("RefAdress1").Range.Text = ActiveSheet.Range("B2") 'Nom Etablissement
oDoc.Bookmarks("RefAdress2").Range.Text = ActiveSheet.Range("BA2") 'Civilité responsable
oDoc.Bookmarks("RefAdress3").Range.Text = ActiveSheet.Range("BB2") 'Nom responsable
oDoc.Bookmarks("RefAdress4").Range.Text = ActiveSheet.Range("AZ2") 'Titre responsable
'---
For Each d In wApp.Documents
mes = mes & vbLf & d.Name
Next
MsgBox Mid(mes, 2), , "Documents Word ouverts"