将下拉列表连接到Excel Slicer

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

期望的结果是，一旦我选择了所需的下拉选项，切片器就会更改以反映我为每个选择布置的结果。

你能告诉我吗？