Question

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

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

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

Market1 Pivot贴到没有位置

Market2枢轴贴到Powerpoint 1＆amp; 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

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

1 个答案: