Question

希望有人可以提供帮助

我正在尝试在vba中调用时间轴切片器值，以便我可以控制其他切片器。我是从单元格管理它，但我想知道它是否可以由我的主切片机控制

Sub Slicer_Time_Change()

Dim startDate As Date, endDate As Date

startDate = Range("A1") 'Set slicer 1 start date as slicer selection instead
endDate = Range("B1")    'Set slicer 1 End date as slicer selection instead


ActiveWorkbook.SlicerCaches("NativeTimeline_Date1").TimelineState. _
SetFilterDateRange startDate, endDate

ActiveWorkbook.SlicerCaches )("NativeTimeline_Date2").TimelineState. _
SetFilterDateRange startDate, endDate

End Sub

非常感谢提前！

Answer 1

自己去回答这个问题！

Sub Slicer_Time_Change()

'Gets data from master slicer selection
Set cache = ActiveWorkbook.SlicerCaches("NativeTimeline_Date1")
'Puts into cell
Cells(1, 1) = cache.TimelineState.startDate
Cells(1, 2) = cache.TimelineState.endDate


Dim startDate As Date, endDate As Date

startDate = Range("A1")
endDate = Range("B1")
'Takes data from cell and controls other slicers with date range
ActiveWorkbook.SlicerCaches("NativeTimeline_Date2").TimelineState. _
SetFilterDateRange startDate, endDate

End Sub

Answer 2

我遇到了同样的问题。你的答案有所帮助但我需要在主切片机改变时触发。不幸的是，切片器没有事件，但它们影响的数据透视表有。当主切片器改变时，下面的代码将更新所有其他时间线切片器，然后改变其数据透视表，然后可以使用它来触发对所有其他切片器的更改。

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

'   Description:Update Timeline Slicers from Master Slicer
'   Inputs:     Sh          PivotTable's worksheet
'               Target      PivotTable being changed/updated
'   Outputs:    *None
'   Requisites: *None
'   Example:    *None - This is an event handler found in ThisWorkbook module

'     Date   Ini Modification
'   10/19/16 CWH Initial Development

'   Declarations
    Const cRoutine      As String = "Workbook_SheetPivotTableUpdate"
    Dim oSlicer         As SlicerCache      'Current Slicer
    Const cSlicer       As Long = 1         'Master Slicer
    Dim dStartDate      As Date             'Start Date
    Dim dEndDate        As Date             'End Date
    Dim bCleared        As Boolean          'Filter Cleared Flag
    Dim bEvents         As Boolean          'Events Enabled Flag

'   Error Handling Initialization
    On Error GoTo ErrHandler

'   Prevent cascading events
    bEvents = Application.EnableEvents
    Application.EnableEvents = False

'   Get Master Slicer's dates
    Set oSlicer = ThisWorkbook.SlicerCaches(cSlicer)
    bCleared = oSlicer.FilterCleared
    If Not bCleared Then
        With oSlicer.TimelineState
            dStartDate = .FilterValue1
            dEndDate = .FilterValue2
        End With
    End If

'   Set All other Timeline Slicer Dates
    For Each oSlicer In ThisWorkbook.SlicerCaches
        If oSlicer.SlicerCacheType = xlTimeline And _
           oSlicer.Index <> cSlicer Then
            If bCleared Then _
                oSlicer.ClearAllFilters Else _
                    oSlicer.TimelineState.SetFilterDateRange _
                        StartDate:=dStartDate, EndDate:=dEndDate
        End If
    Next

ErrHandler:
    Select Case Err.Number
        Case Is = 0:                            'Do nothing
        Case Is = 9:                            'Do Nothing Master Slicer Missing
        Case Else:
            Select Case MsgBox(Prompt:=Err.Description, _
                               Buttons:=vbAbortRetryIgnore, _
                               Title:=cRoutine, _
                               HelpFile:=Err.HelpFile, _
                               Context:=Err.HelpContext)
                Case Is = vbAbort:  Stop: Resume    'Debug mode - Trace
                Case Is = vbRetry:  Resume          'Try again
                Case Is = vbIgnore:                 'End routine
            End Select
    End Select
'   Clean up: Resume responding to events
    Application.EnableEvents = bEvents

End Sub

时间线切片机Excel 2013 VBA

2 个答案: