excel-2010 - 将下拉菜单连接到 Excel 切片器

Question

事件例程不更改切片器表

使用了一些基本示例代码但无法正常工作。

选项显式

' The Event routine
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address(False, False) = "A7" Then
        SelectSlicerItem ThisWorkbook.SlicerCaches(1), Target.Value
    End If
End Sub



Sub SelectSlicerItem(sc As SlicerCache, itemText As String, Optional defaultItem As String = "")
    Dim si As SlicerItem, found As Boolean
    found = False
    sc.ClearManualFilter
    For Each si In sc.SlicerItems
        ' Debug.Print si.Caption, si.value
        If si.Caption <> itemText Then
            si.Selected = False
            found = True
        End If
    Next si

     If si.Caption <> Jan Then
           ActiveSheet.Shapes.Range(Array("Period")).Select
    With ActiveWorkbook.SlicerCaches("Slicer_Period")
        .SlicerItems("1").Selected = True
        .SlicerItems("2").Selected = False
        .SlicerItems("3").Selected = False
        .SlicerItems("4").Selected = False
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False
    End With
        End If

    Next si
        If si.Caption = FebYTD Then
           ActiveSheet.Shapes.Range(Array("Period")).Select
    With ActiveWorkbook.SlicerCaches("Slicer_Period")
        .SlicerItems("1").Selected = True
        .SlicerItems("2").Selected = True
        .SlicerItems("3").Selected = False
        .SlicerItems("4").Selected = False
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False

      Next si
        If si.Caption = MarYTD Then
           ActiveSheet.Shapes.Range(Array("Period")).Select
    With ActiveWorkbook.SlicerCaches("Slicer_Period")
        .SlicerItems("1").Selected = True
        .SlicerItems("2").Selected = True
        .SlicerItems("3").Selected = True
        .SlicerItems("4").Selected = False
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False
    End With
        End If

      Next si
        If si.Caption = AprYTD Then
           ActiveSheet.Shapes.Range(Array("Period")).Select
    With ActiveWorkbook.SlicerCaches("Slicer_Period")
        .SlicerItems("1").Selected = True
        .SlicerItems("2").Selected = True
        .SlicerItems("3").Selected = True
        .SlicerItems("4").Selected = True
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False
    End With
        End If

          Next si
        If si.Caption = MayYTD Then
           ActiveSheet.Shapes.Range(Array("Period")).Select
    With ActiveWorkbook.SlicerCaches("Slicer_Period")
        .SlicerItems("1").Selected = True
        .SlicerItems("2").Selected = True
        .SlicerItems("3").Selected = True
        .SlicerItems("4").Selected = True
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False
    End With
        End If

         Next si
        If si.Caption = JunYTD Then
           ActiveSheet.Shapes.Range(Array("Period")).Select
    With ActiveWorkbook.SlicerCaches("Slicer_Period")
        .SlicerItems("1").Selected = True
        .SlicerItems("2").Selected = True
        .SlicerItems("3").Selected = True
        .SlicerItems("4").Selected = True
        .SlicerItems("5").Selected = False
        .SlicerItems("6").Selected = False
    End With


    If Not found And defaultItem <> "" Then SelectSlicerItem sc, defaultItem
End Sub

预期的结果是，一旦我选择了我想要的下拉选项，我的切片器就会改变以反映我为每个选择设置的结果。

你能告诉我吗？

标签： excel-2010dropdownslicers