当按下切割器时，在excel中禁用其他切割器

Question

我有三个切片操作在一个枢轴表和枢轴图在excel中。然而，当其中一个切割机被按下时，必须清除从另外两个切割机中放置的过滤器，确保只有一个切割机同时工作。我认为必须使用VBA解决这一问题，监听单击，然后执行代码，除此之外，我不知道，因为我以前从未使用过Excel或VBA。有人对我会怎么做有什么建议吗？

Answer 1

计算Slicer被单击的内容确实非常棘手，因为通过单击切片器引发的唯一应用程序事件是PivotTable_Update事件。这个事件告诉我们切片程序连接到哪个PivotTable，但不告诉我们PivotTable中的哪个字段被过滤了。因此，如果您有多个silcers连接到一个PivotTable，您无法判断哪个是刚刚点击的。

我想出了一个非常复杂的解决方案，我在http://dailydoseofexcel.com/archives/2014/07/10/what-caused-that-pivottableupdate-episode-iv/上发布了这个方法，它会告诉您PivotTable中的哪个字段刚刚更新，然后您只需要遍历连接到该PivotTable的所有切片器，如果它们没有相同的原始名称，就清除它们。

我会看看能不能在适当的时候把一些东西编码出来，但是我现在很忙，所以我不能保证一个快速的分辨率。

请注意，可以将宏直接分配给当用户单击该宏时触发的切片器，并由此确定它是哪个切片器。但不幸的是，宏会干扰切割器本身:用户不能再实际操作切割器来实际更改任何内容。

--更新--这是一些你想要的代码这里有很多不同的模块，因为例程代码调用了我使用的其他一些通用例程。它的核心是一个例程，它可以计算出一个PivotTable的哪个特定字段会被更新，而这并不关心是否过滤了multilpe字段。

使用此事件处理程序调用它，该处理程序位于Visual编辑器中图书的ThisWorkbook模块中：

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Slicers_OneSlicerOnly Target
End Sub

这就反过来又把这些其他功能称为。您不需要修改任何内容，这在添加到此工作簿的任何PivotTables或切片程序上都是有效的。

Function Slicers_OneSlicerOnly(target As PivotTable)
Dim sField As String
Dim slr As Slicer
Dim sSlicer As String
Dim bEnableEvents As Boolean
Dim bScreenUpdating As Boolean
Dim bManualupdate As Boolean
Dim lCalculation As Long
Dim bRecordLayout As Boolean
Dim sLayout_New As String
Dim sLayout_Old As String
Dim lng As Long

With Application
    bEnableEvents = .EnableEvents
    bScreenUpdating = .ScreenUpdating
    lCalculation = .Calculation
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
bManualupdate = target.ManualUpdate
target.ManualUpdate = True
sField = Pivots_FieldChange(target)
If sField <> "" Then
    For Each slr In target.Slicers
        sSlicer = slr.SlicerCache.SourceName
        If sSlicer <> sField Then
            If Not target.PivotFields(sSlicer).AllItemsVisible Then
                target.PivotFields(sSlicer).ClearAllFilters
                bRecordLayout = True
            End If
        End If
    Next slr
End If

target.ManualUpdate = bManualupdate
If bRecordLayout Then
    PivotChange_RecordLayout target, sLayout_New
    With target
        lng = InStr(.Summary, "[Layout]")
        sLayout_Old = Mid(.Summary, lng + Len("[Layout]"), InStr(.Summary, "[/Layout]") - Len("[Layout]") - lng)
        .Summary = Replace(.Summary, "[Layout]" & sLayout_Old & "[/Layout]", "[Layout]" & sLayout_New & "[/Layout]")
    End With
End If

With Application
    .EnableEvents = bEnableEvents
    .ScreenUpdating = bScreenUpdating
    .Calculation = lCalculation
End With


End Function

Public Function Pivots_FieldChange(target As PivotTable) As String

'   Description:    Works out what caused a PivotTableUpdate event, and if caused by someone changing a filter returns the
'                   name of the PivotField that was filtered.

'   Programmer:     Jeff Weir
'   Contact:        weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz
'   Inputs:         PivotTable
'   Outputs:        String
'   Name/Version:           Date:       Ini:   Modification:
'   PivotChange_20140712    20140712    JSW     Initial programming as per http://dailydoseofexcel.com/archives/2014/07/10/what-caused-that-pivottableupdate-episode-iv/
'   PivotChange_20140723    20140423    JSW     Restructured code as per http://dailydoseofexcel.com/archives/2014/07/23/broken-arrow/
'   PivotChange_20140802    20140802    JSW     Added: If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then
'                                               so that Filter routines only get called in response to filtering
'   Pivots_FieldChange      20151016    JSW     Changed the way info is saved in .summary

    Dim sLastUndoStackItem As String
    Dim sField As String
    Dim sPossibles As String
    Dim sLayout_New As String
    Dim sLayout_Old As String

    On Error Resume Next 'in case the undo stack has been wiped or doesn't exist
    sLastUndoStackItem = Application.CommandBars(14).FindControl(ID:=128).List(1) 'Standard Commandbar, undo stack
    On Error GoTo 0

    If sLastUndoStackItem = "Filter" Or sLastUndoStackItem = "Slicer Operation" Then
        sField = PivotChange_CompareLayout(target, sLayout_New, sLayout_Old)
        If sField = "" Then sField = PivotChange_EliminationCheck(target, sPossibles)
        If sField = "" Then sField = PivotChange_UndoCheck(target, sPossibles)
        If sLayout_Old = "" Then
            target.Summary = "[Layout]" & sLayout_New & "[/Layout]"
        Else
            target.Summary = Replace(target.Summary, "[Layout]" & sLayout_Old & "[/Layout]", "[Layout]" & sLayout_New & "[/Layout]")
        End If
    End If
    Pivots_FieldChange = sField
    Debug.Print Now() & vbTab & "Pivots_FieldChange:" & vbTab & sField


End Function

 Function PivotChange_RecordLayout(pt As PivotTable, ByRef sLayout_New As String) As Boolean

    Dim pf As PivotField

    For Each pf In pt.PivotFields
        With pf
            Select Case .Orientation
            Case xlRowField, xlColumnField
                sLayout_New = sLayout_New & .Name & "|" & .VisibleItems.Count & "|" & .VisibleItems(1).Name & "||"
            Case xlPageField
                'pf.VisibleItems.Count doesn't work on PageFields
                'So for PageFields we’ll record what that PageField’s filter currently displays.
                '#DEV# Maybe it's quick to iterate through the .VisibleItems collection (if there is one) and count?
                sLayout_New = sLayout_New & .Name & "|" & .LabelRange.Offset(, 1).Value & "|" & .EnableMultiplePageItems & "||"
            End Select
        End With
    Next pf

    End Function


Function PivotChange_CompareLayout(pt As PivotTable, ByRef sLayout_New As String, ByRef sLayout_Old As String) As String


    Dim i As Long
    Dim lng As Long
    Dim vLayout_Old As Variant
    Dim vLayout_New As Variant

    PivotChange_RecordLayout pt, sLayout_New

    With pt
        lng = InStr(.Summary, "[Layout]")
        If lng > 0 Then
            sLayout_Old = Mid(.Summary, lng + Len("[Layout]"), InStr(.Summary, "[/Layout]") - Len("[Layout]") - lng)
            If sLayout_Old <> sLayout_New Then
                vLayout_Old = Split(sLayout_Old, "||")
                vLayout_New = Split(sLayout_New, "||")
                For i = 0 To UBound(vLayout_Old)
                    If vLayout_Old(i) <> vLayout_New(i) Then
                        PivotChange_CompareLayout = Split(vLayout_Old(i), "|")(0)
                        Exit For
                    End If
                Next i
            End If
        Else:
        'Layout has not yet been recorded.
        'Note that we only update .Summary at the end of the main function,
        ' so we don't wipe the UNDO stack before the PivotChange_UndoCheck routine
        End If
    End With

End Function

Function PivotChange_EliminationCheck(pt As PivotTable, ByRef sPossibles As String) As String

    'Check all the visible fields to see if *just one of them alone* has
    ' neither .AllItemsVisible = True nor .EnableMultiplePageItems = false.
    ' If that's the case, then by process of elimination, this field
    ' must be the one that triggered the change, as changes to any of the
    ' others would have been identified in the code earlier.

    Dim pf As PivotField
    Dim lngFields As Long

    lngFields = 0
    On Error Resume Next ' Need this to handle DataFields and 'Values' field
    For Each pf In pt.PivotFields
        With pf
            If .Orientation > 0 Then 'It's not hidden or a DataField
                If .EnableMultiplePageItems And Not .AllItemsVisible Then
                    If Err.Number = 0 Then
                        'It *might* be this field
                        lngFields = lngFields + 1
                        sPossibles = sPossibles & .Name & ";"
                    Else: Err.Clear
                    End If
                End If
            End If
        End With
    Next
    On Error GoTo 0

    If lngFields = 1 Then PivotChange_EliminationCheck = Left(sPossibles, Len(sPossibles) - 1)

End Function




Function PivotChange_UndoCheck(pt As PivotTable, sPossibles) As String

    Dim i As Long
    Dim dicFields As Object 'This holds a list of all visible pivotfields
    Dim dicVisible As Object 'This contains a list of all visible PivotItems for a pf
    Dim varKey As Variant
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim bidentified As Boolean
    Dim lngVisibleItems As Long


    Application.EnableEvents = False

    'Create master dictionary
    Set dicFields = CreateObject("Scripting.Dictionary")

    'Cycle through all pivotfields, excluding totals
    For i = 0 To UBound(Split(sPossibles, ";")) - 1
        'Create dicVisible: a dictionary for each visible PivotField that contain visible PivotItems
        Set dicVisible = CreateObject("Scripting.Dictionary")
        Set pf = pt.PivotFields(Split(sPossibles, ";")(i))
        With pf
        If .Orientation <> xlPageField Then
            For Each pi In .VisibleItems
                With pi
                    dicVisible.Add .Name, .Name
                End With
            Next pi
        Else:
            'Unfortunately the .visibleitems collection isn't available for PageFields
            ' e.g. SomePageField.VisibleItems.Count always returns 1
            ' So we'll have  to iterate through the pagefield and test the .visible status
            ' so we can then record just the visible items (which is quite slow)
             For Each pi In .PivotItems
                With pi
                    If .Visible Then
                        dicVisible.Add .Name, .Name
                    End If
                End With
            Next pi
        End If 'If .Orientation = xlPageField Then
        'Write dicVisible to the dicFields master dictionary
        dicFields.Add .Name, dicVisible
        End With
    Next i

    Application.Undo

    For Each varKey In dicFields.keys
        Set pf = pt.PivotFields(varKey)
        Set dicVisible = dicFields.Item(varKey)

        'Test whether any of the items that were previously hidden are now visible
            If pf.Orientation <> xlPageField Then
                For Each pi In pf.VisibleItems
                    With pi
                        If Not dicVisible.exists(.Name) Then
                            PivotChange_UndoCheck = pf.Name
                            bidentified = True
                            Exit For
                        End If
                    End With
                Next
            Else 'pf.Orientation = xlPageField
                lngVisibleItems = dicVisible.Count
                i = 0
                For Each pi In pf.PivotItems
                    With pi
                        If .Visible Then
                            If Not dicVisible.exists(.Name) Then
                                PivotChange_UndoCheck = pf.Name
                                bidentified = True
                                Exit For
                            Else: i = i + 1 'this is explained below.
                            End If
                        End If
                    End With
                Next

                ' For non-PageFields, we know that the number of .VisibleItems hasn't changed.
                ' But we *don't* know that about Pagefields, and an increase in the amount of
                ' .VisibleItems won't be picked up by our Dictionary approach.
                ' So we'll check if the overall number of visible items changed
                If Not bidentified And i > lngVisibleItems Then
                    PivotChange_UndoCheck = pf.Name
                    Exit For
                End If
            End If
            If bidentified Then Exit For
        Next

    'Resore the original settings
    With Application
        .CommandBars(14).FindControl(ID:=129).Execute 'Standard Commandbar, Redo command
        .EnableEvents = True
    End With


End Function
End Sub