Macro transfert pivotchart vers power point
Bonjour,
Je souhaite créer une macro qui me permettrait de copier les graph d'un pivot chart vers un power point (1 graph par slide) en fonction des différents pivotItems du chart.
Mon pivot chart est fait de plusieurs colonnes (6 à 8 en général) et je souhaiterai pouvoir faire un tri en fonction des colonnes et n'afficher qu'un seul pivotItems sur le graph puis le copier vers un powerpoint et ensuite passer au pivotitems suivant et copier le graph et ainsi de suite jusqu'à "blank" par exemple.
L'idée dans l'exemple est d'avoir les pivotfields switch #, Ron # et Temp figée (donc avec les pivotitems.visible à true) et de pouvoir faire une boucle pour tous les pivotitems du pivotfields "config"
Voici une partie du code que j'utilise, et un fichier avec la macro en PJ...
Si vous avez une astuce pour réaliser cette boucle pour les pivotitems, je suis preneur....
Merci,
Sub ExportChartsToPowerPoint()
'Declare PowerPoint Object Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim SldIndex As Integer
Dim x As Integer
'Declare Excel Object Variables
Dim Chrt As ChartObject
'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True
'Create a new presentation within the application
Set PPTPres = PPTApp.Presentations.Open("C:\Users........\presentation.potx")
'Create an index handler for slide creation
SldIndex = 1
'fixed parameter
ActiveSheet.ChartObjects("Chart 1").Activate
With ActiveChart.PivotLayout.PivotTable.PivotFields("Switch #")
.PivotItems("1").Visible = True
.PivotItems("2").Visible = True
.PivotItems("3").Visible = True
.PivotItems("4").Visible = True
End With
ActiveSheet.ChartObjects("Chart 1").Activate
With ActiveChart.PivotLayout.PivotTable.PivotFields("Ron #")
.PivotItems("Ron1").Visible = True
.PivotItems("Ron2").Visible = True
End With
ActiveSheet.ChartObjects("Chart 1").Activate
With ActiveChart.PivotLayout.PivotTable.PivotFields("Temp")
.PivotItems("25C").Visible = True
.PivotItems("125C").Visible = False
End With
ActiveSheet.ChartObjects("Chart 1").Activate
'rechercher tous les pivots items du pivot fields config, les forcer à false, puis les basculer 1 par 1 à true et copier le graph
With ActiveChart.PivotLayout.PivotTable.PivotFields("Config")
.ClearAllFilters
End With
With ActiveChart.PivotLayout.PivotTable
x = 1
For x = 1 To .PivotFields("config").PivotItems.Count
ActiveChart.PivotLayout.PivotTable.PivotFields("Config").PivotItems(x).Visible = True
ActiveSheet.ChartObjects("Chart 1").Copy
'Create a new slide, set the layout to blank, and paste the chart on the slide
'Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutText)
PPTSlide.Select
'PPTSlide.Shapes.PasteSpecial (ppPastePNG)
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
' Display source name.
'MsgBox "The source name is: " & ActiveSheet.ChartObjects("Chart1").PivotTable.PivotField("Config").PivotItem(x).SourceNameStandard
With ActiveChart.PivotLayout.PivotTable.PivotFields("Config")
.ClearAllFilters
End With
x = x + 1
Next
End With