將多個過濾后的數據透視表復制到多個Powerpoint

Question

我正在嘗試自動制作PowerPoint，因此我可以避免每月制作50張。 我已經設置好代碼，因此它進入我的文件夾並打開所有必要的PowerPoint。 在打開PowerPoint時，它會過濾我的數據透視表，復制並粘貼到正確的文件中。

但是，當我運行Macro時，它會跳過第一個市場

例如：運行宏時-這是我的結果

Market1樞軸粘貼到無處

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

Answer 1

嘗試下面的代碼部分，看它是否對您有幫助：

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