[VBA] copie graphique Excel vers Powerpoint (incorporer classeur

Eddie69003 - 2 déc. 2016 à 16:20 - Dernière réponse :  Eddie69003
- 3 déc. 2016 à 11:59
Bonjour
je cherche à copier des graphiques Excel vers Powerpoint par macros
j'arrive à le copier mais les données restent liées à la feuille Excel
je voudrais que chaque graphique soit indépendant de la feuille Excel (données incorporées dans le fichier PPT)
j'arrive à faire la copie à la main en choisissant "collage spécial incorporer le fichier Excel", mais je n'arrive pas à trouver le code VBA pour le faire (même en enregistrant la macro manuellement)
Si quelqu'un connaît l'option pour le code VBA, ça me ferait gagner un temps fou
====
Sub NouvellePresentation()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim nbshpe As Integer
Dim Gr As Workbook

Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add

With PptDoc

.Slides.Add Index:=1, Layout:=ppLayoutBlank

Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=100, Width:=150, Height:=60)


Sh.TextFrame.TextRange.Text = Range("A1")

Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)

Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)

'copie le 1er graphique contenu dans la feuille Excel active

ActiveSheet.ChartObjects(1).Copy
Diapo.Shapes.PasteSpecial


=================================================
=================================================
j'ai teste avec les options de PAsteSPecial et je ne trouve pas

================================================
================================================




nbshpe = Diapo.Shapes.Count

With Diapo.Shapes(nbshpe)
.Name = "monGraph" 'personnalise le nom
.Left = 150 'définit la position horizontale dans le slide
.Top = 100 'définit la position verticale dans le slide
.Height = 300 'hauteur
.Width = 400 'largeur
End With

PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "Eddie.pptx"
PptDoc.Close
PptApp.Quit

End Sub


======================


merci !

Eddie

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
Afficher la suite 

4 réponses

Répondre au sujet
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionModérateurStatut 11 avril 2018 Dernière intervention - 2 déc. 2016 à 18:15
0
Utile
Bonjour,
Commence par corriger ce qui saute au yeux : deux blocs With et un seul End With.
remets ensuite ton code (corrigé) entre balises codes, s'il te plait.
Commenter la réponse de ucfoutu
0
Utile
voici le code corrigé :



Sub NouvellePresentation()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim nbshpe As Integer
Dim Gr As Workbook

Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add

With PptDoc

.Slides.Add Index:=1, Layout:=ppLayoutBlank

Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=100, Width:=150, Height:=60)


Sh.TextFrame.TextRange.Text = Range("A1")

Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)

Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)

'copie le 1er graphique contenu dans la feuille Excel active

Diapo.Shapes.PasteSpecial

'=======================================
'j'ai teste avec les options de PAsteSPecial et je ne trouve pas
'========================================

nbshpe = Diapo.Shapes.Count

end with

With Diapo.Shapes(nbshpe)
.Name = "monGraph" 'personnalise le nom
.Left = 150 'définit la position horizontale dans le slide
.Top = 100 'définit la position verticale dans le slide
.Height = 300 'hauteur
.Width = 400 'largeur
End With

PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "Eddie.pptx"
PptDoc.Close
PptApp.Quit

End Sub



merci !

Eddie
Commenter la réponse de Eddie69003
cs_Le Pivert 5067 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 23 avril 2018 Dernière intervention - 3 déc. 2016 à 11:39
0
Utile
Bonjour,

Comme ceci:

'Allez dans Outils-Références-Cochez Microsoft PowerPoint 11.0 Object Library
Option Explicit
Sub Inserer_graph()
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer

Dim PptApp As Variant
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add

With PptDoc
'--- Ajoute un nouveau slide
Set Diapo = .Slides.Add(Index:=1, Layout:=ppLayoutBlank)

'copie le 1er graphique contenu dans la feuille Excel active
ActiveSheet.ChartObjects(1).Copy
'collage dans la 1ère diapositive
Diapo.Shapes.Paste

'Compte le nombre de shapes dans la diapositive:
'le dernier objet inséré correspond à l'index le plus élevé
NbShpe = Diapo.Shapes.Count

'Renomme et met en forme l'objet collé
With Diapo.Shapes(NbShpe)
.Name = "monGraph" 'personnalise le nom
.Left = 150 'définit la position horizontale dans le slide
.Top = 100 'définit la position verticale dans le slide
.Height = 300 'hauteur
.Width = 400 'largeur
End With

End With

'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs FileName:=ThisWorkbook.Path & "\" & "NouvellePresentation_graph.ppt" 'enregistrer avec le classeur Excel, à modifier le chemin si besoin
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit

MsgBox "Opération terminée."

End Sub

Commenter la réponse de cs_Le Pivert
0
Utile
Bonjour

Merci cS_Le Pivert mais ton code ne résout pas mon problème de collage des graphiques

En fait, mon client souhaiterais que les graphiques ne soient pas liées à un fichier Excel, mais incorporer dans PPT... comme un graphique créé directement dans PPT

J'arrive à le faire à la main en fait Copier "Utiliser le Thème de Destination et Incorporer le Classeur (S)"

Si j'enregistre la macro, je récupère ça :


ActiveSheet.ChartObjects("Graphique 2").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy


Je n'ai même pas le ".Paste"

J'ai cherché dans les options de PasteSpecial et je ne retrouve pas cette option

Si tu connais ou si tu sais où je peux trouver cette option, merci par avance :)

Eddie
Commenter la réponse de Eddie69003

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.