copier coller depuis un onglet graphique.

Question

Bonjour, 
 J'ai un petit problème, je n'arrive pas à copier un graphique ce situant d'ans un onglet graphique et aler le coller dans un autre fichier en Format:="Image (métafichier amélioré)".
J'ai essayé de le faire via l'outil "Enregistrer une macro..." mais même avec le code qui en sort cela ne fonctionne pas.
Ci-joint le code de l'enregistreur :
    Windows("Suivi DFR  S7 + courbe charge.xlsx").Activate
    Sheets("2017CEC1").Select
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveChart.ChartArea.Copy
    Windows("Suivi des DFR - S06 rev8- Tableau base outil.xlsm").Activate
    Range("F2").Select
    ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:= False, DisplayAsIcon:=False
J'ai un message erreur "Erreur d'exécution '-2147024809(80070057)': L'élément portant ce nom est introuvable. sur la ligne " ActiveSheet.ChartObjects("Graphique 1").Activate"
Je ne sais pas comment résoudre le problème.
Merci d'avance pour votre aide et vos idées.
--

Patrice33740 · Answer

Bonjour aurore52230

Essaies ce code (les deux fichiers doivent être dans le même répertoire, sinon adapter le code) :
Option Explicit
Sub maMacro()
' Constantes
Const nomClasseur$ = "Suivi DFR S7 + courbe charge.xlsx"
Const nomFeuille$ = "2017CEC1"
' Variables
Dim classeur As Workbook
Dim graphique As Chart
Dim chemin As String
  
  ' Définir le classeur contenant le graphique
  chemin = ThisWorkbook.Path & "\"  'ou autre à personnaliser
  On Error Resume Next
  Set classeur = Workbooks(nomClasseur)
  If classeur Is Nothing Then 
    ' - si le classeur n'est pas ouvert, l'ouvrir
    Set classeur = Workbooks.Open(chemin & nomClasseur)
  End If
  On Error GoTo 0
  If classeur Is Nothing Then
    MsgBox "Le classeur : " & nomClasseur & vbCrLf & _
           "n'a pas été trouvé dans le répertoire : " & vbCrLf & _
           chemin, vbCritical
    Exit Sub
  End If
  ' Définir le graphique
  On Error Resume Next
  Set graphique = classeur.Sheets(nomFeuille)
  On Error GoTo 0
  If graphique Is Nothing Then
    MsgBox "La feuille graphique : " & nomFeuille & vbCrLf & _
           "n'a pas été trouvé dans le classeur :" & vbCrLf & _
           nomClasseur, vbCritical
    Exit Sub
  End If
  ' Copier une image du graphique
  graphique.CopyPicture
  ' Activer la cellule de destination
  ThisWorkbook.Activate
  ThisWorkbook.Worksheets(1).Activate
  ThisWorkbook.Worksheets(1).Range("D3").Activate
  ' Coller l'image du graphique
  ThisWorkbook.Worksheets(1).Paste
  ' Et éventuellement refermer le classeur du graphique
  classeur.Saved = True
  classeur.Close
End Sub

Copier coller depuis un onglet graphique.

1 réponse

Votre réponse

Discussions similaires