Dans un TCD, sélectionner les valeurs d'un champ l'une après l'autre

Bonjour,

Je suis plus ou moins débutante en VBA et après de multiples essais et recherches sans succès, je me décide à poster ma question.

Je dois faire un rapport en powerpoint d'après un tableau croisé dynamique (il y avait plusieurs étapes de mises en forme des données brutes avant le TCD, mais je suis maintenant quasiment au bout de ce que je veux faire). Cela se reproduira régulièrement, c'est pour cela que j'ai fait des macros car les copier/coller manuels pour les mises en forme des données brutes, c'est long et source d'erreur.

Dans ce TCD, il y a un champ "PCM" pour lequel je trace un graphe. A chaque fois que je sélectionne un nouveau nom de PCM, le graphe s'ajuste et ma macro copie le graphe puis le colle dans la présentation powerpoint (en ajoutant une diapo à chaque fois).

Actuellement, j'ai créé (grâce à pas mal de visites sur des forums...) une macro qui fonctionne bien, mais à chaque fois, elle me demande de sélectionner un nouveau PCM, puis me demande si je l'ai bien sélectionné et si je dis oui, ça copie et colle mon graphe.

Je pourrais donc me satisfaire de ça, mais le "problème" c'est que j'ai 53 PCM différents et faire la manip à chaque fois, ça finit par être pénible. Je voudrais donc que cela sélectionne automatiquement chaque PCM un par un, et qu'à chaque fois cela copie le graphe correspondant et le colle dans le powerpoint. J'ai essayé plusieurs choses, mais rien qui n'a fonctionné, et je n'ai pas encore trouvé de post qui réponde à ma demande.

J'espère avoir été assez claire dans mes explications et je vous remercie par avance si vous pouvez m'apporter un peu d'aide, et je vous souhaite une très bonne journée (et une bonne année, puisqu'on est au tout début)

Voici mon code actuel :

Sub Export_Powerpoint_1()

Dim appPpt As Object
Dim Pptpre As Object
Dim sld As Object
Dim SlideNb As Integer

Set appPpt = CreateObject("Powerpoint.Application")
appPpt.Visible = True

Set Pptpre = appPpt.Presentations.Open("C:\Users\xxxxxxxxxx\Présentation1.pptx")

Pptpre.slides(3).Delete
Set sld = Pptpre.slides.Add(3, 12)

ActiveSheet.ChartObjects(1).Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
Pptpre.slides(3).Shapes.Paste

SlideNb = Pptpre.slides.Count
For i = 1 To 52
    Set sld = Pptpre.slides.Add((SlideNb + i), 12)
    Pptpre.slides(SlideNb + i).Select
    MsgBox "Veuillez sélectionner un autre paramètre"
    Dim S As Double
    S = Timer + 5
    While Timer < S
    DoEvents
    Wend
    If MsgBox("Avez vous changé de paramètre ?", vbYesNo, "Demande de confirmation") = vbYes Then
    ActiveSheet.ChartObjects.Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    Pptpre.slides(SlideNb + i).Shapes.Paste
    End If

Next
End sub

Bonjoour le forum,

Je viens de marquer le sujet comme résolu car j'ai finalement trouvé une solution ainsi :

With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields("PCM")

.PivotItems(1).Visible = True

For i = 2 To .PivotItems.Count

.PivotItems(i).Visible = False

Next i

End With

ActiveSheet.ChartObjects(1).Select

ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

Pptpre.slides(3).Shapes.Paste

SlideNb = Pptpre.slides.Count

With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields("PCM")

For i = 1 To .PivotItems.Count - 1

.PivotItems(i + 1).Visible = True

.PivotItems(i).Visible = False

ActiveSheet.ChartObjects.Select

ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

Set sld = Pptpre.slides.Add((SlideNb + i), 12)

Pptpre.slides(SlideNb + i).Select

Pptpre.slides(SlideNb + i).Shapes.Paste

Next i

End With