1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
| Sub Export_graph_Word()
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim Nom_doc As String
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim Deb As Integer
Dim Fin As Integer
Application.ScreenUpdating = False
wdApp.ScreenUpdating = False
Nom_doc = Application.GetOpenFilename(FileFilter:="Word.Document(*.docx;*.doc),*.docx;*.doc", Title:="S?lectionnez un document Word") 'permet d'ouvrir une fen?tre pour d?finir le document Word ? ouvrir
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(Nom_doc)
K = 0 'permet de compter le nombre de graphiques pass?s en revue
For I = 1 To Sheets.Count 'passe en revue les onglets du fichier
Sheets(I).Activate
'Boucle pour selectionner un ? un les graphiques de la feuille active et faire les modifications
For J = 1 To ActiveSheet.ChartObjects.Count
Sheets(I).ChartObjects(J).CopyPicture 'copie le graphique s?lectionn? en format image
K = K + 1 'impl?mente le compteur de graphiques
wdDoc.Activate 'active le fichier Word
Deb = wdDoc.Bookmarks("Graph" & K).Start 'rep?re le d?but du signet concern?
Fin = wdDoc.Bookmarks("Graph" & K).End 'rep?re la fin du signet concern?
wdDoc.Bookmarks("Graph" & K).Range.Select 'permet d'atteindre le signet correspondant ? l'emplacement du graphique
wdDoc.Bookmarks("Graph" & K).delete 'supprime les donn?es du signet (et supprime le signet en m?me temps)
wdApp.Selection.PasteAndFormat (wdChartPicture) 'collage du graphique en format image
wdApp.Selection.InsertParagraphAfter 'ins?re un saut de ligne
wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 'centre le graphique
wdDoc.Range(Deb, Fin).Bookmarks.Add ("Graph" & K) 'on recr?e le signet avec les infos d?but et fin de l'emplacement
Next J
Next I
wdApp.ScreenUpdating = True
wdApp.Selection.Goto What:=wdGoToPage, Count:=1 'aller ? la 1?re page du doc Word
wdApp.ActiveDocument.Save 'enregistrement du docx Word
Application.CutCopyMode = False 'vide le presse-papier
Application.ScreenUpdating = True
MsgBox "EXPORT GRAPHIQUES WORD OK"
End Sub |
Partager