copier un graph dans une zone

Version imprimable

Bonjour,

alors voila j'ai écris un code qui me permet d'ouvrir un fichier de copier un graphique et de le coller dans une autre feuille.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Macro1() ' Fichier_LIBERATION_PF = "Libération PF.xlsm" Chemin_LIBE = "T:\DIRECTIONCQ\PLANIF CQ\PLANNING CQ PHARMA 2019" Application.Workbooks.Open Filename:=Chemin_LIBE & "\" & Fichier_LIBERATION_PF, ReadOnly:=True Workbooks(Fichier_LIBERATION_PF).Worksheets("Graphs").Activate ActiveSheet.Shapes.Range(Array("Graphique 2", "Graphique 2")).Select Application.CutCopyMode = False Selection.Copy ThisWorkbook.Worksheets("Feuil3").Activate Range("A1").Select ActiveSheet.Paste End Sub
Savez-vous si c'est possible de le copier et de le coller dans une zone précise car j'aimerai imprimer ensuite la feuille.

En faite je veux créer une sorte de tableau de bord, avec un bouton impression, quand je clique sur ce bouton
je veux copier tous les graphs en provenance d'autres les fichiers, les coller et ensuite les imprimer automatiquement sans avoir a refaire la mise en page

Je vous ai mis ce que j'ai écris pour le moment pour que vous puissez voir ou j'en suis

Avez vous des pistes des tuto qui peuvent m'aider peut être ?

Merci pour votre aide :)

Bonjour,

Une piste.

Code:

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
Option Explicit
 
Private Sub btnPrintGraph()
   PoserImage "Libération PF.xlsm", "Graphique 1"
   PoserImage "Libération PF.xlsm", "Graphique 2"
   PoserImage "Libération PF.xlsm", "Graphique 3"
End Sub
 
Private Sub PoserImage(sFichier As String, sGraph As String)
   Dim sChemin As String
   ActiveSheet.Shapes(1).Delete     '--- il faut effacer l'image précédente
   sChemin = "T:\DIRECTIONCQ\PLANIF CQ\PLANNING CQ PHARMA 2019"
   Application.Workbooks.Open FileName:=sChemin & "\" & sFichier, ReadOnly:=True
   Workbooks(sFichier).Worksheets("Graphs").Activate
   ActiveSheet.Shapes.Range(Array(sGraph, sGraph)).Select
   Application.CutCopyMode = False
   Selection.Copy
   ThisWorkbook.Worksheets("Feuil3").Activate
   Range("A1").Select
   ActiveSheet.Paste
   With Selection.ShapeRange
      .Top = 1
      .Left = 1
      .Width = 400
      .Height = 200
   End With
   ActiveSheet.PrintOut Preview:=True  '--- aperçu avant impression
End Sub

Bonne continuation.

02/04/2019, 17h40
MarcelG

Salut,

A mon sens, afin d'éviter toute liaison intempestive, mieux vaut copier ces graphiques en image. (Méthode CopyPicture).