Use VBA to select and deselect multiple slicer ite

问题:

I am working on a script which selects only the needed slicer items. I tried using .SlicerItems.Selected = True / False for selecting and deselecting but I am using an OLAP data source in which case .Selected is read-only. The slicer items are in the format of YYYYWW so 7th week of 2018 would be 201807.

I recorded a macro selecting some slicer items and this is what it gave me:

Sub Macro2()
    ActiveWorkbook.SlicerCaches("Slicer_YYYYWW").VisibleSlicerItemsList = Array( _
        "[Results].[YYYYWW].&[201726]", "[Results].[YYYYWW].&[201727]", _
        "[Results].[YYYYWW].&[201728]", "[Results].[YYYYWW].&[201729]", _
        "[Results].[YYYYWW].&[201730]", "[Results].[YYYYWW].&[201731]", _
        "[Results].[YYYYWW].&[201732]", "[Results].[YYYYWW].&[201733]", _
        "[Results].[YYYYWW].&[201734]", "[Results].[YYYYWW].&[201735]", _
        "[Results].[YYYYWW].&[201736]", "[Results].[YYYYWW].&[201737]", _
        "[Results].[YYYYWW].&[201738]", "[Results].[YYYYWW].&[201739]", _
        "[Results].[YYYYWW].&[201740]", "[Results].[YYYYWW].&[201741]", _
        "[Results].[YYYYWW].&[201742]", "[Results].[YYYYWW].&[201743]", _
        "[Results].[YYYYWW].&[201744]", "[Results].[YYYYWW].&[201745]", _
        "[Results].[YYYYWW].&[201746]", "[Results].[YYYYWW].&[201747]", _
        "[Results].[YYYYWW].&[201748]", "[Results].[YYYYWW].&[201749]", _
        "[Results].[YYYYWW].&[201750]", "[Results].[YYYYWW].&[201751]", _
        "[Results].[YYYYWW].&[201801]", "[Results].[YYYYWW].&[201802]", _
        "[Results].[YYYYWW].&[201803]")
End Sub

So I tried following this template and create an array like that. This is how far I have gotten:

Sub arrayTest()

Dim startDate As Long
    Dim endDate As Long
    Dim n As Long
    Dim i As Long
    Dim strN As String
    Dim sl As SlicerItem
    Dim strArr As Variant
    Dim dur As Long
    Dim result As String

    endDate = Range("C17").Value ' endDate is the last SlicerItem to be selected
    startDate = Range("G17").Value ' startDate is the first SlicerItem to be selected
    dur = Range("C19").Value ' duration is the the number of SlicerItems to be selected
    i = 0
    ReDim strArr(dur) As Variant
    With ActiveWorkbook.SlicerCaches("Slicer_YYYYWW")
'            .ClearManualFilter
        For n = startDate To endDate
            strN = CStr(n) ' convert n to string
            If n = 201753 Then ' this is needed for when the year changes
                strN = CStr(201801)
                n = 201801
            End If
            strArr(i) = """[Results].[YYYYWW].&[" & strN & "]""" ' write string into array
            i = i + 1

'                For Each sl In .SlicerCacheLevels(1).SlicerItems
'                    If sl.Name = strN Then
'                        sl.Selected = True
'                    Else
'                        sl.Selected = False ' this is read-only for OLAP data so it's not working
'                    End If
'                Next

        Next
        MsgBox Join(strArr, ", ") ' the MsgBox returns the correct string to be applied to select the right slicer items

        .VisibleSlicerItemsList = Join(strArr, ", ") ' Error 13: Type mismatch
    End With

End Sub

Currently, the code gives Error 13: Type mismatch on .VisibleSlicerItemsList = Join(strArr, ", "), which is also commented. So I'm guessing that either dimensioning strArr as Variant is wrong, the data is not inserted correctly into strArr or it's just impossible to do it this way. In the case of the latest one, how should I do it?

The part commented out on lines 29-35 does not work as it gives the usual error of Application-defined or object-defined error (1004) on sl.Selected = False.

回答1:

I had a similar issue to overcome. Which I resolved using the following code:

Sub show_SlicerItems()

Dim sc As SlicerCache
Dim sL As SlicerCacheLevel
Dim si As SlicerItem
Dim slicerItems_Array()
Dim i As Long

Application.ScreenUpdating = False

    Set sc = ActiveWorkbook.SlicerCaches("Slicer_Name")
    Set sL = sc.SlicerCacheLevels(1)

    ActiveWorkbook.SlicerCaches("Slicer_Name").ClearManualFilter

    i = 0

    For Each si In sL.SlicerItems
        ReDim Preserve slicerItems_Array(i)

        If si.Value <> 0 Then
            slicerItems_Array(i) = si.Name
            i = i + 1
        End If
    Next

sc.VisibleSlicerItemsList = Array(slicerItems_Array)

Application.ScreenUpdating = True
End Sub

回答2:

You need to feed .VisibleSlicerItemsList an array, not a string. Ditch the Join.

And your strArr assignment should be like this: strArr(i) = "[Results].[YYYYWW].&[" & strN & "]" i.e. you don't need to pad it out with extra "

Edit: Out of interest, I happen to be building a commercial add-in that is effectively a Pop-up Slicer, that allows you to filter an OLAP PivotTable to show all items between a range like you are attempting to do. It also lets you filter on wildcards, crazy combinations of AND and OR, and filter on lists stored in external ranges.

Here's a screenshot of it in action. Note there is a search bar up the top that lets you use < or > together to set lower and upper limits, which is what I've done in the current Search. And you can see the result: it has correctly identified the 14 items from the PivotField that fit the bill.

All I need to do to filter the PivotTable on these is click the "Filter on selected items" option, and it does just that:

But working out how to do this - particularly given the limitations of the PivotTable object model (especially where OLAP PivotTables are concerned) was a VERY long term project, with many, many hurdles to overcome to make it work seamlessly. I can't share the code I'm afraid, as this is a commercial offering that I aim to release shortly. But I just wanted to highlight that while this is certainly possible, you are going to be biting off quite a bit if you want it to not throw errors when items don't exist.

回答3:

Forget my other answer...you can use the Labels Filter to do this easily, provided the field of interest is in the PivotTable as either a Rows or Columns field. Fire up the Macro Recorder, and do the following:

...and you'll see that the PivotTable gets filtered:

...and the resulting code is pretty simple:

ActiveSheet.PivotTables("PivotTable1").PivotFields("[Table1].[YYYYWW].[YYYYWW]" _
        ).PivotFilters.Add2 Type:=xlCaptionIsBetween, Value1:="201726", Value2:= _
        "201803"