Lister filtres visibles de TCD avec VBA

Bonjour,

Je viens chercher de l'aide pour surmonter un problème qui consiste à lister les critères de filtrage cochés d'un tableau croisé dynamique.

J'utilise le code suivant.

Sub lister_filtres_tcd_1()
    Dim pvtTable As PivotTable
    Dim pvtItem As PivotItem
    Dim nwSheet As Worksheet

    Set nwSheet = Worksheets.Add
    nwSheet.Activate

    Worksheets("tcd").Select

    Set pvtTable = Worksheets("tcd").PivotTables("tcd1")

    rw = 0
    For Each pvtItem In pvtTable.PivotFields("NOM_FORMATEUR").PivotItems
        If pvtItem.Visible = True Then
            rw = rw + 1
            nwSheet.Cells(rw, 1).Value = pvtItem.Name
        End If
    Next pvtItem
End Sub

Mais il ne passe jamais dans la condition si plusieurs items sont sélectionnés dans le filtre (en revanche il y passe quand un seul item est sélectionné).

J'ai aussi essayé avec le code suivant mais je n'obtiens que la valeur "All" en cas de sélection multiple. Quand un seul item est sélectionné ça fonctionne.

Sub lister_filtres_tcd_2()
    Dim pvtTable As PivotTable
    Dim pvtItem As PivotItem
    Dim pvtField As PivotField
    Dim nwSheet As Worksheet

    Set nwSheet = Worksheets.Add
    nwSheet.Activate

    Worksheets("tcd").Select

    Set pvtTable = Worksheets("tcd").PivotTables("tcd1")

    For i = 1 To pvtTable.VisibleFields.Count
        Set pvtField = pvtTable.VisibleFields(i)
        With pvtField
           If pvtField.Orientation = xlPageField Then
               For j = 1 To pvtField.VisibleItems.Count
                   Set pvtItem = pvtField.VisibleItems(j)
                   nwSheet.Cells(j, 1).Value = pvtItem.Name
               Next j
           End If
        End With
    Next i
End Sub

Pouvez-vous me dire où je me trompe svp ?

Bonjour,

Une première proposition.

Ne fonctionnera pas avec des dates.

Cdlt.

Option Explicit

Private Sub cmdLister_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim n As Long

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set pt = Me.PivotTables(1)
    Set pf = pt.PageFields("Produit")
    pf.EnableMultiplePageItems = True

    On Error Resume Next
    wb.Worksheets("Liste").Delete
    On Error GoTo 0

    Application.DisplayAlerts = True

    Set ws = wb.Worksheets.Add
    ws.Name = "Liste"

    For Each pi In pf.PivotItems
        If pi.Visible = True Then
            n = n + 1
            ws.Cells(n, 1).Value = pi.Name
        End If
    Next pi

    Set pf = Nothing: Set pt = Nothing
    Set wb = Nothing

End Sub

Bonjour,

Et merci pour votre aide.

Dans votre fichier, votre code produit le résultat escompté 8)

(Sauf quand on désactive la sélection multiple dans le filtre du tcd et qu'on ne sélectionne qu'un item. Alors tous les items sont listés à cause du EnableMultiplePageItems = True. Mais c'est un problème contournable il me semble).

Mon problème reste cependant là car votre code ne produit pas de résultat dans mon fichier.

Je joins celui-ci en p.j. Pourriez-vous y jeter un coup d'oeil svp ?

Une chose que je ne comprends pas dans votre fichier. Le code n'est pas celui d'une macro ? Je ne vois aucune macro proposée par Affichage>Macro. Du coup, comment le code est-il associé au contrôle Lister (c'est bien un contrôle ?) ?

Bonjour,

je pense que tu as la réponse à tes questions sur un autre forum.

Sinon à la base c'est la version du TCD crée avec Excel 97-2003 qui pose souci.

Cdlt.