2010 VBA与切片器

我是平

数据源如附件；
代码如下：
Sub pivottableMacro1()
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Sheets("数据源").Range("a1").CurrentRegion, Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion14
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("部门")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("月")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1" _
        ).PivotFields("发生额"), "求和项:发生额", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("日")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("PivotTable1"), "部门"). _
        Slicers.Add ActiveSheet, , "部门", "部门", 75, 342, 144, 198.75
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("PivotTable1"), "科目划分"). _
        Slicers.Add ActiveSheet, , "科目划分", "科目划分", 75, 542, 144, 198.75

End Sub

预期效果图如下：


实现方式：
利用VBA 宏代码实现

问题：
1. 第一次运行代码的时候okay，即能实现效果图, 第二次运行代码(不删除第一次运行代码产生的透视表)出现如图错误，切片器不能显示了
这里代码要如何修改


2. 此段代码总体上要如何精练，总感觉太冗长了

感谢您的帮助！
====================================解答分割线==========================


问题1：因为工作簿中的切片器名称不允许重复，只需要删除切片器名称即可。代码如下：
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("PivotTable1"), "科目划分"). _
        Slicers.Add ActiveSheet, , , "科目划分", 75, 542, 144, 198.75

问题2： 2010代码精简
Sub pivottableMacro1()
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Sheets("数据源").Range("a1").CurrentRegion, Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14

    ActiveSheet.PivotTables("pivottable1").AddFields RowFields:="部门", ColumnFields:="月", PageFields:="日"
    ActiveSheet.PivotTables("PivotTable1").AddDataField field:=ActiveSheet.PivotTables("PivotTable1" _
        ).PivotFields("发生额"), Caption:=" 发生额", Function:=xlSum

    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("PivotTable1"), "部门"). _
        Slicers.Add ActiveSheet, , , "部门", 75, 342, 144, 198.75
    ActiveWorkbook.SlicerCaches.Add(ActiveSheet.PivotTables("PivotTable1"), "科目划分"). _
        Slicers.Add ActiveSheet, , , "科目划分", 75, 542, 144, 198.75
End Sub

在和弦处等你

附件嘛都没有。。。

我是平

在和弦处等你 发表于 2013-6-15 02:26
附件嘛都没有。。。

意外，意外
已经更新附件，
麻烦帮忙研究下

在和弦处等你

想要达到什么效果啊，附件中没有详细的问题描述啊。

我是平

在和弦处等你 发表于 2013-6-15 10:04
想要达到什么效果啊，附件中没有详细的问题描述啊。

不好意思，帖子上面有写得比较详细

system096

感谢老师分享

【思域无疆】

这个帖子不错嘛，怎么沉底了呢？