将多个已过滤的透视表复制到多个电源点

时间:2017-05-02 14:42:41

标签: excel excel-vba vba

我正在尝试自动制作PowerPoints,这样我就可以避免每月制作50个。我设置了代码,因此它进入我的文件夹并打开所有必要的powerpoint。在打开powerpoint时,它会将我的数据透视表,副本和粘贴过滤到正确的文件中。

但是 - 当我运行宏时 - 它会跳过第一个市场

例如:运行宏时 - 这是我的结果

Market1 Pivot贴到没有位置

Market2枢轴贴到Powerpoint 1& Powerpoint 2

Market3 Pivot贴到Powerpoint 3

我假设它与我的“On Error Resume Next”行有关,但不确定如何解决这个问题。 这是我的代码:

'Open Powerpoints

Set pptapp = CreateObject("Powerpoint.Application")
pptapp.Visible = True

market = Array("market1", "market2", "market3")

For i = 0 To UBound(market)
    'open Powerpoints
    Set pptpres = pptapp.Presentations.Open("Powerpoint Folders")
    Set pptslide = pptpres.Slides(7)
    'update pivot tables
    Application.ScreenUpdating = False

    ws1.Activate    
    Set Tradepivot = ws1.PivotTables("PivotTable1")  
    With Tradepivot.PivotFields("Market")
        On Error Resume Next
        For z = (0 - 1) To (.PivotItems.Count)
            .PivotItems(.PivotItems(z).Name).Visible = False
            .PivotItems((market(i)) & " Market").Visible = True    
            Tradepivot.TableRange1.copy
        Next z

        pptslide.Shapes.PasteSpecial DataType:=ppPasteOLEObject
        pptapp.CommandBars.ExecuteMso ("PasteSourceFormatting")    
    End With        
Next i

1 个答案:

答案 0 :(得分:0)

尝试以下代码部分,看看它是否对您有所帮助:

Dim PvtFld As PivotField
Dim PvtItm As PivotItem

With Tradepivot
    Set PvtFld = .PivotFields("Market")
    PvtFld.ClearAllFilters
    For Each PvtItm In PvtFld.PivotItems
        If PvtItm.Name = market(i) Then
            PvtItm.Visible = True
        Else
            PvtItm.Visible = False
        End If                
    Next PvtItm
    Tradepivot.TableRange1.Copy

    pptslide.Shapes.PasteSpecial DataType:=ppPasteOLEObject
    pptapp.CommandBars.ExecuteMso ("PasteSourceFormatting")
End With