Question

所以我已经想出如何将一个数据透视表保存到指定的文件夹中作为.PDF，但我很好奇是否有人知道是否有办法循环我的代码而不是将它们全部分开？

我的代码有效，但我很好奇是否有办法压缩它？

Sub Test1234()          

 '''Sales Team1''' 
Sheets("Worksheet1").Activate
'''adjust the range if the Pivot Table moves'''
Range("C3").Select   
ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters
'''adjust the vertical name in the quotes below'''
ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = _
"Sales Team1"
Sheets("Worksheet1").Select 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy")

'''Sales Team2''' 
Sheets("Worksheet1").Activate
'''adjust the range if the Pivot Table moves'''
Range("C3").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters
'''adjust the vertical name in the quotes below'''
ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = _
"Sales Team2"
Sheets("Worksheet1").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy")

 '''Sales Team3''' 
Sheets("Worksheet1").Activate
'''adjust the range if the Pivot Table moves'''
Range("C3").Select
ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters
'''adjust the vertical name in the quotes below'''
ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = _
"Sales Team3"
Sheets("Worksheet1").Select 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy")

End Sub

Answer 1

尝试下面的代码，不需要一直使用Activate和Select（这也会降低代码运行时间。）

阅读HERE为什么你应该远离Select / Activate / Selection / ActiveSheet等。

<强>代码

Option Explicit

Sub Test1234()

Dim PvtTbl      As PivotTable
Dim PvtFld      As PivotField
Dim ws          As Worksheet
Dim i           As Long

' set the worksheet where "PivotTable2"
Set ws = Worksheets("Worksheet1")

' set the Pivot Table
Set PvtTbl = ws.PivotTables("PivotTable2")

' set the Pivot Field "Vertical"
Set PvtFld = PvtTbl.PivotFields("Vertical")
With PvtFld
    For i = 1 To 3
        .ClearAllFilters

        'adjust the vertical name in the quotes below
        .CurrentPage = "Sales Team" & i
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Desktop" & Format(Date, " dd.mm.yyyy")
    Next i
End With

End Sub

Answer 2

你可以通过一个for循环来完成它。

Sub test_m()

    Dim wsh As Worksheet
    Dim i As Integer
    Dim team As String


    Set wsh = Sheets("Worksheet1")

    For i = 1 To 3

            team = "Sales Team" & i
            wsh.Activate

            '''adjust the range if the Pivot Table moves'''
            Range("C3").Select

        wsh.PivotTables("PivotTable2").PivotFields("Vertical").ClearAllFilters

        '''adjust the vertical name in the quotes below'''       

   ActiveSheet.PivotTables("PivotTable2").PivotFields("Vertical").CurrentPage = team
        Sheets("Worksheet1").Select

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=team & _
        Format(Date, " dd.mm.yyyy")

    Next i

End Sub

数据透视表到PDF循环？

2 个答案: