添加切片缓存

时间:2016-08-29 21:54:30

标签: excel-vba excel-2013 vba excel

我正在开发一个包含多个数据透视表和切片器的应用程序。

我尝试准备模板表并复制 - 粘贴它以创建多个分析。

当我复制工作表时,Slicer将链接到原始和新的数据透视表(属于同一个SlicerCache),因此我需要:

  • 取消原始SlicerCache与新数据透视表的链接
  • 从新工作表中删除原始Slicer
  • 使用相同的连接设置创建新的SlicerCache
  • 在新工作表上创建新的Slicer,属于新的SlicerCache

到目前为止我的代码:

Function DuplicateSlicer(PreviousSlicer As Slicer) As Slicer
    Dim NewSlC As SlicerCache
    Dim NewSlicer As Slicer
    Dim DestWorkSheet As Worksheet
    Dim SlCSequence As Integer
    Dim NewSlCName As String

    With PreviousSlicer
        Set DestWorkSheet = .Parent
        .SlicerCache.PivotTables.RemovePivotTable (DestWorkSheet.PivotTables(1))
        SlCSequence = 1
        Do Until GetSlicerCache(DestWorkSheet.Parent, .SlicerCache.Name & SlCSequence) Is Nothing
            SlCSequence = SlCSequence + 1
        Loop
        NewSlCName = .SlicerCache.Name & SlCSequence
        Set NewSlC = DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
            .SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
        Set NewSlicer = NewSlC.Slicers.Add(DestWorkSheet, Caption:=.SlicerCache.SourceName, _
            Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)

        NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData

        .Delete
    End With

End Function

我的问题在于线路 DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _ .SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)

根据MSDN help,即使没有指定名称也应该有效:

  

Excel用于引用切片器缓存的名称(值的值)   SlicerCache.Name属性)。如果省略,Excel将生成一个名称。通过   默认情况下,Excel连接"切片器_"与价值   具有非OLAP数据源的切片器的PivotField.Caption属性,   ...(用" _"替换任何空格。)如果需要制作名称   在工作簿命名空间中是唯一的,Excel在末尾添加一个整数   生成的名称。如果指定了已存在的名称   workbook命名空间,Add方法将失败。

然而,即使我使用上面的代码,或者我只是省略了第3个参数,我也会继续

  

错误1004:切片器缓存已存在。

为了使事情变得更复杂,如果我使用一个变量作为Slicercach.Add(NewSlCName = .SlicerCache.Name & SlCSequence)的名称参数,我会得到不同的一个:

  

错误:5"无效的过程调用或参数"

enter image description here

我真的不知道如何解决它。

更新

我已经使用了SlicerCaches.Add2,因为它可以从对象提示中获得 根据{{​​3}} .Add已被弃用,不应使用 我还尝试.Add代替.Add2,它也会出现同样的错误。

1 个答案:

答案 0 :(得分:0)

到目前为止,我可以做的唯一方法是:

使用相同的布局和数据透视表创建两个模板,其中一个使用切片器,另一个没有。

要创建新工作表:复制没有切片器的模板,然后运行下面的代码以在新工作表中创建切片器:

Sub DuplicateSlicers(NewWorkSheet As Worksheet, SourceWorkSheet As Worksheet)
    Dim SlC As SlicerCache
    Dim sl As Slicer

    For Each SlC In SourceWorkSheet.Parent.SlicerCaches
        For Each sl In SlC.Slicers
            If (sl.Parent Is SourceWorkSheet) Then
                Call DuplicateSlicer(sl, NewWorkSheet)
            End If
        Next sl
    Next SlC
End Sub

Function DuplicateSlicer(PreviousSlicer As Slicer, NewSheet As Worksheet) As Slicer
    Dim NewSlC As SlicerCache
    Dim NewSlicer As Slicer

    If PreviousSlicer Is Nothing Then
        Set DuplicateSlicer = Nothing
        Exit Function
    End If

    On Error GoTo ErrLabel

    With PreviousSlicer
        Set NewSlC = NewSheet.Parent.SlicerCaches.Add2(NewSheet.PivotTables(1), _
            .SlicerCache.SourceName)
        Set NewSlicer = NewSlC.Slicers.Add(NewSheet, Caption:=.Caption, Top:=.Top, Left:=.Left, _
            Width:=.Width, Height:=.Height)
    End With
    NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
    Set DuplicateSlicer = NewSlicer

    Exit Function

ErrLabel:
    Debug.Print PreviousSlicer.Caption & " - " & Err.Number & ": " & Err.Description
    Err.Clear

End Function