Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 VBA - Exporter graphiques vers word

kaisermpt

XLDnaute Occasionnel
Bonjour,

Dans le cadre de la réalisation de rapports, je dois exporter des graphiques vers un fichier Word dans lequel je vais les insérer avec des signets.

J'ai récupéré ce code. Il fonctionne si on a un seul fichier word et excel. Compte tenu que je vais avoir de nombreux rapports, pourriez m'indiquer comment je fais pour indiquer un nom de fichier précis pour excel et word.

Dans mon exemple, mon fichier excel s'appelle "RESULTATS CONSOLIDES" et mon fichier word "RAPPORT ENTITE VILLE"

Merci d'avance

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim ws As Worksheet
Dim i As Integer

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets(1) 'Onglet contenant les graphiques

' - On suppose que le fichier Word est déjà ouvert
Set wrdApp = GetObject(, "Word.Application") 'Word déjà ouvert
Set wrdDoc = wrdApp.ActiveDocument

' -- Copier le 1er Graphique nommé "Graph_Ventes"
ActiveSheet.ChartObjects("Graph_Ventes").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="Graphique1" ' on recherche le signet dans Word pour se positionner
'wrdApp.Selection.MoveLeft wdCharacter, 1 ' optionnel : pour se placer AVANT le signet (move left)
wrdApp.Selection.PasteSpecial link:=False, DataType:=wdpastemetafilepicture, Placement:=wdinline, displayasicon:=False

' -- Copier le 2e Graphique nommé "Graph_Vendeurs"
ActiveSheet.ChartObjects("Graph_Vendeurs").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="Graphique2" ' on recherche le signet dans Word pour se positionner
wrdApp.Selection.MoveRight wdCharacter, 1 ' optionnel pour se placer APRES le signet (move right)
wrdApp.Selection.PasteSpecial link:=False, DataType:=wdpastemetafilepicture, Placement:=wdinline, displayasicon:=False

' -- Terminer
wrdDoc.Save
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.ScreenUpdating = True

End Sub
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Coté Excel remplacez peut être ActiveSheet par Workbooks("RESULTATS CONSOLIDES.xlsx").Worksheets(1)
Ou au début Set Ws = Workbooks("RESULTATS CONSOLIDES.xlsx").Worksheets(1)
et ensuite Ws à la place de ActiveSheet
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…