attrapper les sous-totaux d'un TCD par macros

[atlas]

Boujour , je souhaiterais "attrapper" les sous-totaux du champ (rowfields) nommé "SITE" de mon tcd .

Pour cela lancer la macro "TCDautomatique"

Ensuite dans la procédure "ListAllItemObjects"

avec le morceau de code suivant j'arrive à choper chaques items 1 à 1
mais pas les sous-totaux de chaques items .

For i = 1 To nbitem

MsgBox mafeuil.PivotTables("Tableau croisé dynamique3").RowFields(2).PivotItems(i)

Next

Ce que je veux récuper ce sont les adresses de "Total OISE OUEST"
"Total OISE EST" "Total FLANDRES ARTOIS" "Total SOMME"
et non pas "OISE OUEST" etc ...
"OISE EST" "FLANDRES ARTOIS" "SOMME"

 

[PMO2]

Re : attrapper les sous-totaux d'un TCD par macros

Bonjour,

Essayez de remplacer la Sub ListAllItemObjects(mafeuil) par

Sub ListAllItemObjects(mafeuil)

Dim pvt As PivotTable
Dim fld As PivotField
Dim itm As PivotItem
Dim i, j As Integer
Dim nbitem As Long

Const PREFIXE As String = "Total "
Dim A$
Dim R As Range

MsgBox mafeuil.PivotTables("Tableau croisé dynamique3").RowFields(2)
'MsgBox mafeuil.PivotTables("Tableau croisé dynamique3").RowFields(2).PivotItems.Count
nbitem = mafeuil.PivotTables("Tableau croisé dynamique3").RowFields(2).PivotItems.Count

For i = 1 To nbitem
  A$ = mafeuil.PivotTables("Tableau croisé dynamique3").RowFields(2).PivotItems(i)
  Set R = mafeuil.Cells.Find(PREFIXE & A$, LookIn:=xlValues)
  If Not R Is Nothing Then MsgBox A$ & vbTab & R.Address(False, False, xlA1)
Next

End Sub

Cordialement.

PMO
Patrick Morange