VBAselect每个切片机项目，然后将每个选定的切片机项目保存为PDF格式？

我devise了一个由许多不同的数据透视表和透视图组成的仪表盘。

所有这些数据透视表/图表都由1个称为“Slicer_Store”的切片器控制。

在这个切片机中有大约800个不同的商店可供select。

我需要保存每个商店的仪表板的PDF。 手动select每个切片器项目，然后将该工作表保存为PDF文件的过程是非常耗时的800多家商店，所以我希望通过VBA自动化该过程。

这是我的代码到目前为止：

Public Sub myMacro() Dim sI As SlicerItem, sI2 As SlicerItem, sC As SlicerCache Set sC = ActiveWorkbook.SlicerCaches("Slicer_Store") With sC For Each sI In sC.SlicerItems sC.ClearManualFilter For Each sI2 In sC.SlicerItems If sI.Name = sI2.Name Then sI2.Selected = True Else: sI2.Selected = False Next Debug.Print sI.Name 'add export to PDF code here ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\TestUser\Desktop\testfolder" & Range("b1").Text & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False Next End With End Sub 

---

代码虽然处理所有虽然切片机项目，但该文件不被保存为PDF格式。 我需要将每个文件保存为B2中的值，因此它将是Store1.pdf，Store2.pdf，Store3.pdf等。

任何帮助将非常感激。 这是一个很大的工程，很多人都依赖于这些pdf文件..

---

编辑的代码：

这应该工作，但它需要永远超过所有的切片机项目（800 +）。 此外，我需要确保它只打印第一页（打印区域），所以切片机本身不会被打印。

 Public Sub myMacro() Dim sI As SlicerItem, sI2 As SlicerItem, sC As SlicerCache Dim ws As Worksheet Set sC = ActiveWorkbook.SlicerCaches("Slicer_Store_Number") Set ws = Sheet18 With sC For Each sI In sC.SlicerItems sC.ClearManualFilter For Each sI2 In sC.SlicerItems If sI.Name = sI2.Name Then sI2.Selected = True Else: sI2.Selected = False Next Debug.Print sI.Name 'add export to PDF code here ws.PageSetup.PrintArea = ws.Range("A1:N34").Address ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\testuser\Desktop\testfolder" & Range("M1").Text & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False Next End With End Sub 

Answer 1

这实际上解决了这个问题，但是你对800+项目的方法将会永远完成。 请参阅下面的另一个解决scheme，它需要来自用户的一点点协作，但速度要快得多。

在打印到PDF之前添加此行：

  Range("b1") = sI.Name 

这将把商店的名称写入范围，以便以后可以使用它作为您的PDF文件的名称。

另外，在path的末尾添加一个斜杠：

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\TestUser\Desktop\testfolder\" & Range("b1").Text & ".pdf", Quality:= _ 

如果您只想打印第一页，则可以在上面的行之前设置打印区域，或者使用以下命令：

 ActiveSheet.PrintOut from:=1, To:=1 

UPDATE

在这个解决scheme中，您需要确保第一个切片器项目，并且只有那个被选中（所以你不应该清除手动filter）。 这是根据这个编码的。 原始代码每次遍历所有的切片器项目，select一个并取消select导致极高计算成本的其他代码。

 Public Sub myMacro() Dim sC As SlicerCache Set sC = ActiveWorkbook.SlicerCaches("Slicer_Store_Number") 'This reminds the user to only select the first slicer item If sC.VisibleSlicerItems.Count <> 1 Or sC.SlicerItems(1).Selected = False Then MsgBox "Please Only Select Store-Number 1" Exit Sub End If For i = 1 To sC.SlicerItems.Count 'Do not clear ilter as it causes to select all of the items (sC.ClearManualFilter) sC.SlicerItems(i).Selected = True If i <> 1 Then sC.SlicerItems(i - 1).Selected = False 'Debug.Print sI.Name 'add export to PDF code here With Sheet18.PageSetup .PrintArea = Sheet18.Range("A1:N34" & lastRow).Address .FitToPagesWide = 1 .FitToPagesTall = 1 End With Sheet18.Range("M1") = sC.SlicerItems(i).Name 'This prints to C directory, change the path as you wish Sheet18.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\" & Range("M1").Text & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False Next End Sub