Copier graphique excel sur word [Résolu]

Signaler
-
 Enshuk -
Bonjour,

J'ai conçu une macro sur excel, dont l'objectif est de récupérer tous les graphiques présents dans un classeur excel et commençant par le même nom (exemple : Graphique).

Et d'ensuite les copier sous forme d'image dans un fichier Word.

Ça fonctionne, sauf qu'au lieu d'afficher tous les graphiques, il semblerait que la macro écrase les précédents pour afficher que le dernier.


Sub Export_Chart_Word()


'Name of an existing Word document, and the name the chart will have when exported.

Const stWordDocument As String = "C:\Users\xxxxxx\Documents\ChartReport.docx"
Const stChartName As String = "ChartReport.png"

'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range

'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim ChartObj As ChartObject

'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = ActiveSheet



For Each Graphique In wsSheet.ChartObjects
If Left(Graphique.Name, 5) = "Chart" Then Set ChartObj = Graphique
ChartObj.Chart.Export _
Filename:=wbBook.Path & "\" & Graphique.Name, _
FilterName:="PNG"

Next



'Turn off screen updating.
'Application.ScreenUpdating = False


'Initialize the Word objects to the existing Word document and bookmark.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(stWordDocument)
Set wdbmRange = wdDoc.Bookmarks("ChartReport").Range



'If there is already an inline shape, that means the macro has been run before - clean up any artifacts.
On Error Resume Next
With wdDoc.InlineShapes(1)
.Select
.Delete
End With
On Error GoTo 0

'Add the .gif file to the document at the bookmarked location,
'and ensure that it is saved inside the Word doc.
With wdbmRange
.Select
.InlineShapes.AddPicture _
Filename:=wbBook.Path & "\" & stChartName, _
LinkToFile:=False, _
savewithdocument:=True
End With

'Save and close the Word document.
With wdDoc
.Save
.Close
End With

'Quit Word.
wdApp.Quit

'Clear the variables.
Set wdbmRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing

'Delete the temporary . file.
On Error Resume Next
Kill wbBook.Path & "C:\Users\xxxxxx\Documents" & stChartName
On Error GoTo 0

MsgBox "Chart exported successfully to " & stWordDocument

End Sub



Voilà la boucle en question :



For Each Graphique In wsSheet.ChartObjects
If Left(Graphique.Name, 5) = "Chart" Then Set ChartObj = Graphique
ChartObj.Chart.Export _
Filename:=wbBook.Path & "\" & Graphique.Name, _
FilterName:="PNG"

Next


Merci d'avance pour votre aide.

1 réponse

Messages postés
6924
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 septembre 2020
549
Merci beaucoup !t