VBA 到 select 每个切片器项目然后将每个 select 编辑的切片器项目保存为 pdf?
VBA to select each slicer item AND then save each selected slicer item as a pdf?
我设计了一个仪表板,其中包含许多不同的数据透视表和数据透视图。
所有这些枢轴 tables/charts 都由 1 个名为 "Slicer_Store" 的切片器控制。
此切片器中大约有 800 家不同的商店可供选择。
我需要保存每个商店仪表板的 pdf 文件。手动选择每个切片器项目,然后将 sheet 保存为 pdf 文件的过程对于 800 多家商店来说非常耗时,所以我希望通过 VBA.[=14= 自动化该过程]
到目前为止,这是我的代码:
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
这实际上解决了问题,但是您获得 800 多个项目的方法将永远无法完成。请参阅下面的另一种解决方案,该解决方案需要用户进行一些协作,但速度要快得多。
在打印为 PDF 之前添加此行:
Range("b1") = sI.Name
这会将商店名称写入范围,以便稍后您可以将其用作 pdf 文件的名称。
此外,在路径末尾添加斜线:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\TestUser\Desktop\testfolder\" & Range("b1").Text & ".pdf", Quality:= _
如果你只想打印第一页,你可以在上面的行之前设置打印区域或者使用这个:
ActiveSheet.PrintOut from:=1, To:=1
更新
在此解决方案中,您需要确保第一个切片器项目,并且只有那个被 selected(因此您不应清除手动过滤器)。这是基于此编码的。原始代码每次都会遍历所有切片器项目,select 一个并且 deselect 其他导致极高的计算成本。
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
Sub FacultyToPDF()
Dim wb As String
Dim sh As Worksheet
Dim fname As String
Dim location As String
Dim sI As SlicerItem, sI2 As SlicerItem, sC As SlicerCache
Dim index As Integer
Const PrintRange = "Print_Area"
fPath = "C:\Users\xiaz01\Desktop\Special Project\PDF"
Set sC = ActiveWorkbook.SlicerCaches("Slicer_billing_phys_name")
For Each sI In ActiveWorkbook.SlicerCaches("Slicer_billing_phys_name").SlicerCacheLevels(1).SlicerItems
ActiveWorkbook.SlicerCaches("Slicer_billing_phys_name").VisibleSlicerItemsList = Array(sI.Name)
fname = Range("B1").Text & Format(Date, " yy-mm-dd") & ".pdf"
Range(PrintRange).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\" & fname
Next
End Sub
我设计了一个仪表板,其中包含许多不同的数据透视表和数据透视图。
所有这些枢轴 tables/charts 都由 1 个名为 "Slicer_Store" 的切片器控制。
此切片器中大约有 800 家不同的商店可供选择。
我需要保存每个商店仪表板的 pdf 文件。手动选择每个切片器项目,然后将 sheet 保存为 pdf 文件的过程对于 800 多家商店来说非常耗时,所以我希望通过 VBA.[=14= 自动化该过程]
到目前为止,这是我的代码:
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
这实际上解决了问题,但是您获得 800 多个项目的方法将永远无法完成。请参阅下面的另一种解决方案,该解决方案需要用户进行一些协作,但速度要快得多。
在打印为 PDF 之前添加此行:
Range("b1") = sI.Name
这会将商店名称写入范围,以便稍后您可以将其用作 pdf 文件的名称。
此外,在路径末尾添加斜线:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\TestUser\Desktop\testfolder\" & Range("b1").Text & ".pdf", Quality:= _
如果你只想打印第一页,你可以在上面的行之前设置打印区域或者使用这个:
ActiveSheet.PrintOut from:=1, To:=1
更新
在此解决方案中,您需要确保第一个切片器项目,并且只有那个被 selected(因此您不应清除手动过滤器)。这是基于此编码的。原始代码每次都会遍历所有切片器项目,select 一个并且 deselect 其他导致极高的计算成本。
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
Sub FacultyToPDF()
Dim wb As String
Dim sh As Worksheet
Dim fname As String
Dim location As String
Dim sI As SlicerItem, sI2 As SlicerItem, sC As SlicerCache
Dim index As Integer
Const PrintRange = "Print_Area"
fPath = "C:\Users\xiaz01\Desktop\Special Project\PDF"
Set sC = ActiveWorkbook.SlicerCaches("Slicer_billing_phys_name")
For Each sI In ActiveWorkbook.SlicerCaches("Slicer_billing_phys_name").SlicerCacheLevels(1).SlicerItems
ActiveWorkbook.SlicerCaches("Slicer_billing_phys_name").VisibleSlicerItemsList = Array(sI.Name)
fname = Range("B1").Text & Format(Date, " yy-mm-dd") & ".pdf"
Range(PrintRange).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & "\" & fname
Next
End Sub