Copie de feuilles de graphique dans des diapositives PowerPoint, Excel VBA

La section Essayer de cette leçon explique comment copier un graphique incorporé dans PowerPoint. Si vous avez le choix entre copier des graphiques incorporés ou des feuilles de graphique, choisissez des graphiques incorporés – ils vous offrent un meilleur contrôle sur la façon dont ils peuvent être dimensionnés pour s’adapter à une diapositive PowerPoint. Cela est dû au fait que l’objet ChartObject est le conteneur d’un graphique incorporé et qu’il possède des propriétés que vous pouvez contrôler pour la hauteur, la largeur et l’emplacement (où vous pouvez le placer dans la feuille de calcul). Les graphiques sur les feuilles de graphique ne vous permettent pas de contrôler leur taille.
Parfois, vous n’aurez pas le choix, par exemple lorsqu’un projet demande la copie de feuilles de graphique dans PowerPoint, et c’est ce que la macro suivante accomplit. Pour aller plus loin, cette macro effectue les opérations suivantes:
1. Crée une nouvelle présentation PowerPoint.
2. Ajoute une diapositive de titre initiale.
3. Fait une boucle sur toutes les feuilles de graphique et, avec chacune d’elles, copie son image et la colle dans une nouvelle diapositive.
4. Place un titre d’en-tête sur chaque diapositive, puis le remplit avec le nom du graphique et formate le texte.
5. Enregistre le fichier.

Sub CopierGraphiqueFeuille()
'Déclarez des variables d'objet pour l'application

'PowerPoint et pour le fichier de présentation PowerPoint.
Dim powerpApp As Object, powerpPres As Object
'Déclarez la variable objet pour une diapositive PowerPoint.
Dim powerpSlide As Object
'Déclarez les variables des graphiques que vous allez copier.
Dim graphiqueA As Chart
'Déclarez une variable de type Integer pour un nombre

'en cours de diapositives lorsque chaque feuille

'de graphique est ajoutée au nouveau fichier de présentation.
Dim SlideCount As Integer
'Ouvrir PowerPoint.
Set powerpApp = CreateObject("PowerPoint.Application")
'Rendez l'application PowerPoint visible.
powerpApp.Visible = msoTrue
'Créez une nouvelle présentation et ajoutez une diapositive de titre.
Set powerpPres = powerpApp.Presentations.Add
With powerpPres.Slides
Set powerpSlide = .Add(.Count + 1, 11)
End With
powerpSlide.Shapes.Title.TextFrame.TextRange.Text = "Test de copie de feuille de graphique"
'Ouvrez une boucle For… Next pour placer chaque feuille
'de graphique dans une diapositive.
For Each graphiqueA in ThisWorkbook.Charts
graphiqueA.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen
'Ajoutez une nouvelle diapositive.
SlideCount = powerpPres.Slides.Count
Set powerpSlide = powerpPres.Slides.Add(SlideCount + 1, 11)
powerpApp.ActiveWindow.View.GotoSlide powerpSlide.SlideIndex
'Collez et sélectionnez l'image du graphique.

powerpSlide.Shapes.Paste
'Sélectionnez la forme collée.
powerpSlide.Shapes(1).Select
'Alignez le graphique pour qu'il soit centré dans la diapositive.
With powerpApp.ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, msoTrue
.Align msoAlignMiddles, msoTrue
End With
'Définissez la position de l'étiquette d'en-tête de la diapositive.
With powerpApp.ActiveWindow.Selection
.SlideRange.Shapes.AddLabel _
(msoTextOrientationHorizontal, 300, 20, 500, 50).Select
.ShapeRange.TextFrame.WordWrap = msoFalse
'Formatez l'étiquette d'en-tête
With .ShapeRange.TextFrame.TextRange
.Characters(Start:=1, Length:=0).Select
.Text = "This is " & graphiqueA.Name
With .Font
.Name = "Arial"
.Size = 12
.Bold = msoTrue
End With
End With
End With
'Continuez la boucle jusqu'à ce que toutes les feuilles
'de graphique aient été copiées.
Next graphiqueA
'Terminez la macro en activant la première diapositive.
powerpApp.ActiveWindow.View.GotoSlide 1
'Enregistrez votre nouveau fichier.
powerpPres.SaveAs Filename:=ThisWorkbook.Path & "\GraphiqueFeuilleTest.pptx"
'Libérez la mémoire système réservée aux variables Object.
Set powerpApp = Nothing
Set powerpSlide = Nothing
Set powerpPres = Nothing
Set powerpApp = Nothing
End Sub

 

S’abonner
Notifier de
0 Commentaires
Inline Feedbacks
Voir tous les commentaires

Initiation à Excel

Fonctions Excel

Excel VBA

Macros VBA Utiles

Plus d'outils

Sur Facebook

Sur YouTube

0
Nous aimerions avoir votre avis, veuillez laisser un commentaire.x