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 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
| 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
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
With PptDoc
'--- Ajoute un Slide
.Slides.Add Index:=1, Layout:=ppLayoutBlank
'--- Ajoute un nouveau slide et le positionner en 2eme position
Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
'--- Premier changement
ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").CurrentPage = "NOM ENTREPRISE"
'copie le 1er graphique contenu dans la feuille Excel active
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
'collage dans la 2eme diapositive
PptDoc.Slides(2).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
'--- Ajoute un nouveau slide et le positionner en 2eme position
Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
'--- Premier changement
ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("retailer_name").CurrentPage = "NOM ENTREPRISE"
'copie le 1er graphique contenu dans la feuille Excel active
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
'collage dans la 2eme diapositive
PptDoc.Slides(2).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.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
MsgBox "Opération terminée."
End Sub |
Partager