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 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
| Sub Export_Graphiques_Vers_Word()
' Cette macro permet de transférer de copier les graphiques contenus
' vers un document Word (gabarit)
' Les 2 fichiers doivent se trouver dans le même répertoire.
' Il faut au préalable définir des signets dans le gabarit Word afin d'insérer le texte
'
' Grand Chaman Excel 2013-03-15
Sheets("graph").Select
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
Sheets("graph").Select
Range("O45").Select
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("Expotot").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="Expotot" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("PropI").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropI" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("PropO").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropO" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("PropR").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropR" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("PropIEBF").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropIEBF" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("NC").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="NC" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("NI").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="NI" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("NE").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="NE" ' 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.Paste
' -- Copier le 1er Graphique nommé "fig1"
ActiveSheet.ChartObjects("Nambiant").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="Nambiant" ' 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.Paste
Sheets("diag").Select
Range("O45").Select
If [G5>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("DSS").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="DSS" ' 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.Paste
End If
If [G23>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("DRDC").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="DRDC" ' 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.Paste
End If
If [G41>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D1").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D1" ' 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.Paste
End If
If [G59>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D2").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D2" ' 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.Paste
End If
If [G77>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D3").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D3" ' 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.Paste
End If
If [G95>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D4").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D4" ' 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.Paste
End If
If [G113>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D5").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D5" ' 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.Paste
End If
If [G131>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D6").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D6" ' 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.Paste
End If
If [G149>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D7").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D7" ' 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.Paste
End If
If [G167>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D8").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D8" ' 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.Paste
End If
If [G185>0] Then ' => SI condition validée ALORS
ActiveSheet.ChartObjects("D9").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D9" ' 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.Paste
End If
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.ScreenUpdating = True
Sheets("Cas A").Select
End Sub |