XL 2013 Identifier les éléments "actifs" d'un segment

Sub Test()
Dim Slc As SlicerCache, Cas As SlicerItem

    For Each Slc In Me.SlicerCaches
        Debug.Print Slc.VisibleSlicerItems.Count & " éléments affichés pour " & Slc.Name
        For Each Cas In Slc.VisibleSlicerItems
            Debug.Print Cas.Caption
        Next
        Debug.Print
    Next
    
End Sub

Sub Test()
    Dim Counta As Long, Countm As Long, a As Integer, m As Integer, s As Integer

' Segment Année
    With Me.SlicerCaches("Segment_Année")
        a = .VisibleSlicerItems.Count
        Select Case True
        Case .FilterCleared: MsgBox "Pas de filtre actif sur le segment Année"
        Case a = 0:          MsgBox "Aucune sélection sur le Segment Année"
        Case Else:           MsgBox a & " items sélectionnés sur le Segment Année"
        End Select
    End With
 
' Segment Mois
    With Me.SlicerCaches("Segment_Mois")
        m = .VisibleSlicerItems.Count
        Select Case True
        Case .FilterCleared: MsgBox "Pas de filtre actif sur le segment Mois"
        Case m = 0:          MsgBox "Aucune sélection sur le Segment Mois"
        Case Else:           MsgBox m & " items sélectionnés sur le Segment Mois"
        End Select
    End With
 
' Segment Semaine
    With Me.SlicerCaches("Segment_Semaine")
        s = .VisibleSlicerItems.Count
        Select Case True
        Case .FilterCleared: MsgBox "Pas de filtre actif sur le segment Semaine"
        Case s = 0:          MsgBox "Aucune sélection sur le Segment Semaine"
        Case Else:           MsgBox s & " items sélectionnés sur le Segment Semaine"
        End Select
    End With
 
End Sub