Dim wrdApp As Word.Application
Dim wrdDoc As Word.document, templateDoc As Word.document
Dim NomDocument As String, sPath As String, WDoc As String
'on ouvre Word pour commencer
Set wrdApp = CreateObject("Word.Application") 'on crée un nouvel objet Word
sPath = "le chemin du fichier Word qui va bien"
NomDocument = "le nom du fichier Word de destination"
WDoc = sPath & NomDocument
'Word est ouvert
'on boucle sur tous les documents ouverts et on regarde si NomDocument existe déjà
For i = 1 To wrdApp.Documents.Count
If wrdApp.Documents(i).Name = NomDocument Then
Set wrdDoc = wrdApp.Documents(i)
Exit For
End If
Next i
If wrdDoc Is Nothing Then 'le document n'est pas ouvert
'on ouvre le fichier gabarit et on le renomme (le fichier gabarit n'est plus ouvert ensuite)
Set templateDoc = wrdApp.Documents.Open(sPath & "le nom et l'extension du fichier Word gabarit") 'on ouvre le template
Set wrdDoc = templateDoc
wrdDoc.SaveAs (WDoc) 'renomme le gabarit
End if
'ON FAIT LES MODIFICATIONS DU FICHIER WORD
'On se positionne au bon endroit dans le fichier Word
wrdApp.Windows(wrdDoc).Activate 'il faut d'abord activer la bonne fenêtre (car s'il y en a plusieurs, ça va écrire dans la dernière active)
' -- Copier le 1er Graphique nommé "Graphique 2"
ActiveSheet.ChartObjects("Graphique 2").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="rep" ' on recherche le signet dans Word pour se positionner
With wrdApp.Selection
'on fait ce qu'on a à faire
.PasteSpecial link:=False, DataType:=wdpastemetafilepicture, Placement:=wdinline, displayasicon:=False
.../...
End With
'Terminer
.../...