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 'empêche le rafraîchissement automatique de l'écran Excel
wdApp.ScreenUpdating = False 'idem pour Word
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 doc Word
Application.CutCopyMode = False 'vide le presse-papier
Application.ScreenUpdating = True
MsgBox "EXPORT GRAPHIQUES WORD OK"
End Sub |
Partager