Sub test()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application ' NE PAS OUBLIER DE PRECISER WORD pour EXCEL
'
On Error Resume Next
' Initialisation de Word
Set WordApp = GetObject(, "Word.Application")
If Err <> 0 Then
Err.Clear
Set WordApp = CreateObject("Word.Application")
If Err <> 0 Then
MsgBox "La macro n'a pas pu ouvrir !", vbExclamation
End
End If
End If
On Error GoTo 0
'
WordApp.Visible = True
'
Dim WordDoc As Word.Document
Dim rg As Word.Range
Dim Img As Word.InlineShape
Dim Chemin As String
Chemin = ThisWorkbook.Path & "\"
Dim Fichier As String
Fichier = "02-fichier word2.docx"
Dim nom_societe As String
Dim FichierImage As String
FichierImage = ThisWorkbook.Path & "\SignCD.jpg"
Dim NomSignet As String
NomSignet = "signature"
Dim HauteurImg As Variant
Dim LargeurImg As Variant
' Nouveau fichier enregistrer sous
Dim NomDoc As String
NomDoc = ThisWorkbook.Path & "\Sign_word.docx" ' définition du chemin et nom du doc au créer
'
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\" & Fichier)
With WordDoc
If .Bookmarks.Exists(NomSignet) Then
Set rg = WordDoc.Bookmarks(NomSignet).Range
rg.Select ' car le signet et dans une zone de texte
HauteurImg = WordDoc.Shapes.Item("Text Box 3").Height * 0.03527778 ' en cm
LargeurImg = WordDoc.Shapes.Item("Text Box 3").Width * 0.03527778 ' en cm
Set Img = .InlineShapes.AddPicture(FichierImage, False, True, rg)
Img.Height = HauteurImg * 28.34646
Img.Width = LargeurImg * 28.34646
End If
.SaveAs NomDoc ' On l'enregistre ? là le doc est vide
End With
WordDoc.Close
Set WordDoc = Nothing
WordApp.Quit
Set WordApp = Nothing
End Sub