Discussion :

[Bisbis27]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[EricDgn]

Bonjour,

Une piste.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[MarcelG]

Salut,

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