'générer le word
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application") 'essayé avec New Word.Application
Application.DisplayAlerts = True
AppWord.ShowMe
AppWord.Visible = True
'Ouvre le document Word
Set DocWord = AppWord.Documents.Add
' Copie les données Excel
Dim sh As Shape
Set sh = ActiveSheet.Shapes(Application.Caller)
ThisWorkbook.Worksheets("Classeur1").Range(Cells(1, 1), Cells(sh.TopLeftCell.Offset(5, 0).Row, sh.TopLeftCell.Offset(0, 11).Column)).Copy
' Colle les données dans Word
DocWord.Range.PasteSpecial DataType:=wdPasteRTF, DisplayAsIcon:=True
'copier les images
With ActiveSheet.Range("A1:Q80")
For Each sh In ActiveSheet.Shapes
If sh.Top >= .Top And sh.Left >= .Left _
And sh.Left + sh.Width <= .Left + .Width _
And sh.Top + sh.Height <= .Top + .Height Then
Export_Image ActiveSheet.Shapes(sh.Name)
MsgBox (sh.Name)
DocWord.InlineShapes.AddPicture (ThisWorkbook.Path & "\Temp.jpg")
' puis export/import des autres images ...
'...
' à la fin, éventuellement, si on veux effacer le fichier temporaire à la fin :
Kill ThisWorkbook.Path & "\Temp.jpg"
End If
Next sh
End With
Application.CutCopyMode = False
On Error Resume Next
'DocWord.Application.ActiveDocument.Save
DocWord.SaveAs "tableau.doc"