Copier coller depuis un onglet graphique.

Signaler
Messages postés
30
Date d'inscription
mercredi 13 février 2008
Statut
Membre
Dernière intervention
21 février 2017
-
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
-
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.
--

1 réponse

Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21
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