使用 VBA 将数据从 Excel 打印为 PDF
Using VBA to Print Data From Excel to PDF
看似非常简单的问题，但我有一个 excel 电子表格，它使用 vba 代码截取某些内容的屏幕截图，将其粘贴到 'Screenshot' 选项卡中，然后将该选项卡导出到一个pdf。我的问题是我传递的分页符与似乎默认生成的分页符线不一致（？）...
代码部分：
Set Screen = Sheets("Screenshots")
Set Block = Sheets("BlockChart")
Set CopyRangeBlock = Block.Range("A1:N51")
Set PasteRange = Screen.Cells(1, 1)
Application.DisplayStatusBar = True
CopyRangeBlock.CopyPicture xlScreen, xlPicture
DoEvents
Screen.Paste Destination:=PasteRange
DoEvents
Sheets("Screenshots").Rows(52).PageBreak = xlPageBreakManual
Application.CutCopyMode = False
屏幕截图的数据范围是 "A1:N:51"，因此我在第 52 行放置了一个分页符。但是，在第 50 行出现了一个虚线分页符线（似乎默认情况下）。这搞砸了我导出为 pdf 并生成空白页。当我循环遍历代码以在 pdf 中生成多个页面时，这尤其是一个问题。我怎样才能使虚线不出现或与我设置的分页符匹配，这样我就不会得到额外的空白页？
示例：
重申一下，整个工作表都有预先确定的打印区域虚线。我基本上想修改这些（通过手动中断或其他方式），以便打印为 pdf 的每个页面都是适合我截图的数据的自定义尺寸。
通过以下代码，您可以将一些示例范围作为屏幕截图粘贴到目标工作表，每个范围之间有一个手动分页符。
我在每张截图前后都留了一行空白（原因：当一个形状的边框直接放在分页处时，边框可能也会打印在相邻的页面上）。
请调整最后一行代码中的缩放级别，以获得打印在一页上的最大屏幕截图（例如 54 %）。如果您想自动计算它，请参阅此答案的第二个代码部分。
Private Sub CollectScreenshots()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim rngExampleRanges As Range
Dim rngCopy As Range
Dim rowPaste As Long
Dim shpScreenshot As Shape
Dim dlg As Dialog
Application.DisplayStatusBar = True
Set wsSource = Sheets("BlockChart")
Set rngExampleRanges = wsSource.Range("A1:N51, A52:B53, C60:E99")
Set wsDestination = Sheets("Screenshots")
' Copy all ranges as screenshot into destination worksheet:
rowPaste = 1
With wsDestination
.ResetAllPageBreaks
For Each rngCopy In rngExampleRanges.Areas
rngCopy.CopyPicture Appearance:=xlScreen, Format:=xlPicture
DoEvents
If rowPaste > 1 Then .HPageBreaks.Add Before:=.Rows(rowPaste)
.Paste Destination:=.Cells(rowPaste + 1, 1), Link:=False
DoEvents
Set shpScreenshot = .Shapes(.Shapes.Count)
rowPaste = shpScreenshot.BottomRightCell.Row + 1
Next rngCopy
End With
Application.CutCopyMode = False
' set appropriate zoom level
wsDestination.PageSetup.Zoom = 54
End Sub
自动缩放级别
如果要Excel计算最佳缩放级别，那就有点复杂了。
如果您有一个单元格区域，例如。 G。 A1:N51，必须打印在1页上，然后你可以像这样手动设置页面对话框参数：
- 定义打印区域为A1:N51
- 将缩放设置为 1 个页面宽度和 1 个页面高度
- 然后您可以在页面设置对话框中直观地看到计算出的缩放级别。
遗憾的是，您无法通过 VBA 直接读取此缩放级别，因为 Worksheet.PageSetup.Zoom 在这种情况下仅 returns False。如果您敦促 Excel 使用缩放级别，例如。 G。通过将 FitToPagesWide 设置为 False，Excel 计算出新的缩放级别。
要读取计算出的缩放级别，您必须将键盘快捷键发送到页面设置对话框。要为此获得正确的键盘快捷键，请在页面设置对话框中检查哪个快捷键用于缩放级别。在我的德语 Excel 版本中，它是 Alt + V.
然后将上面代码的最后一行替换为：
' get cell dimensions of the largest screenshot:
Dim maxVerticalCells, maxHorizontalCells
For Each shpScreenshot In wsDestination.Shapes
maxVerticalCells = Application.WorksheetFunction.Max( _
maxVerticalCells, _
shpScreenshot.BottomRightCell.Row - shpScreenshot.TopLeftCell.Row + 1)
maxHorizontalCells = Application.WorksheetFunction.Max( _
maxHorizontalCells, _
shpScreenshot.BottomRightCell.Column - shpScreenshot.TopLeftCell.Column + 1)
Next shpScreenshot
' set appropriate zoom level
With wsDestination
' Simulate a print area with required dimensions to get it printed to 1 page
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = _
.Range(.Cells(1, 1), .Cells(maxVerticalCells, maxHorizontalCells)).Address
' change the page setup to automatic and keep previous zoom level
' by sending keys to page setup dialog
.Activate
Dim strKeys As String
strKeys = "P" ' key "P" for first tab in that dialog
strKeys = strKeys & "%V" ' key <Alt>+<V> for automatic zoom (German, might be %A in other countries)
strKeys = strKeys & "~" ' key <Enter>
SendKeys strKeys ' send keys to following dialog
Application.Dialogs(xlDialogPageSetup).Show
Dim myZoomlevel As Double
myZoomlevel = .PageSetup.Zoom
' Reset print area, reset automatic page adaption, use previous zoom level
.PageSetup.PrintArea = ""
.PageSetup.FitToPagesWide = False
.PageSetup.FitToPagesTall = False
.PageSetup.Zoom = myZoomlevel
End With
看似非常简单的问题，但我有一个 excel 电子表格，它使用 vba 代码截取某些内容的屏幕截图，将其粘贴到 'Screenshot' 选项卡中，然后将该选项卡导出到一个pdf。我的问题是我传递的分页符与似乎默认生成的分页符线不一致（？）...
代码部分：
Set Screen = Sheets("Screenshots")
Set Block = Sheets("BlockChart")
Set CopyRangeBlock = Block.Range("A1:N51")
Set PasteRange = Screen.Cells(1, 1)
Application.DisplayStatusBar = True
CopyRangeBlock.CopyPicture xlScreen, xlPicture
DoEvents
Screen.Paste Destination:=PasteRange
DoEvents
Sheets("Screenshots").Rows(52).PageBreak = xlPageBreakManual
Application.CutCopyMode = False
屏幕截图的数据范围是 "A1:N:51"，因此我在第 52 行放置了一个分页符。但是，在第 50 行出现了一个虚线分页符线（似乎默认情况下）。这搞砸了我导出为 pdf 并生成空白页。当我循环遍历代码以在 pdf 中生成多个页面时，这尤其是一个问题。我怎样才能使虚线不出现或与我设置的分页符匹配，这样我就不会得到额外的空白页？
示例：
重申一下，整个工作表都有预先确定的打印区域虚线。我基本上想修改这些（通过手动中断或其他方式），以便打印为 pdf 的每个页面都是适合我截图的数据的自定义尺寸。
通过以下代码，您可以将一些示例范围作为屏幕截图粘贴到目标工作表，每个范围之间有一个手动分页符。
我在每张截图前后都留了一行空白（原因：当一个形状的边框直接放在分页处时，边框可能也会打印在相邻的页面上）。
请调整最后一行代码中的缩放级别，以获得打印在一页上的最大屏幕截图（例如 54 %）。如果您想自动计算它，请参阅此答案的第二个代码部分。
Private Sub CollectScreenshots()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim rngExampleRanges As Range
Dim rngCopy As Range
Dim rowPaste As Long
Dim shpScreenshot As Shape
Dim dlg As Dialog
Application.DisplayStatusBar = True
Set wsSource = Sheets("BlockChart")
Set rngExampleRanges = wsSource.Range("A1:N51, A52:B53, C60:E99")
Set wsDestination = Sheets("Screenshots")
' Copy all ranges as screenshot into destination worksheet:
rowPaste = 1
With wsDestination
.ResetAllPageBreaks
For Each rngCopy In rngExampleRanges.Areas
rngCopy.CopyPicture Appearance:=xlScreen, Format:=xlPicture
DoEvents
If rowPaste > 1 Then .HPageBreaks.Add Before:=.Rows(rowPaste)
.Paste Destination:=.Cells(rowPaste + 1, 1), Link:=False
DoEvents
Set shpScreenshot = .Shapes(.Shapes.Count)
rowPaste = shpScreenshot.BottomRightCell.Row + 1
Next rngCopy
End With
Application.CutCopyMode = False
' set appropriate zoom level
wsDestination.PageSetup.Zoom = 54
End Sub
自动缩放级别
如果要Excel计算最佳缩放级别，那就有点复杂了。
如果您有一个单元格区域，例如。 G。 A1:N51，必须打印在1页上，然后你可以像这样手动设置页面对话框参数：
- 定义打印区域为A1:N51
- 将缩放设置为 1 个页面宽度和 1 个页面高度
- 然后您可以在页面设置对话框中直观地看到计算出的缩放级别。
遗憾的是，您无法通过 VBA 直接读取此缩放级别，因为 Worksheet.PageSetup.Zoom 在这种情况下仅 returns False。如果您敦促 Excel 使用缩放级别，例如。 G。通过将 FitToPagesWide 设置为 False，Excel 计算出新的缩放级别。
要读取计算出的缩放级别，您必须将键盘快捷键发送到页面设置对话框。要为此获得正确的键盘快捷键，请在页面设置对话框中检查哪个快捷键用于缩放级别。在我的德语 Excel 版本中，它是 Alt + V.
然后将上面代码的最后一行替换为：
' get cell dimensions of the largest screenshot:
Dim maxVerticalCells, maxHorizontalCells
For Each shpScreenshot In wsDestination.Shapes
maxVerticalCells = Application.WorksheetFunction.Max( _
maxVerticalCells, _
shpScreenshot.BottomRightCell.Row - shpScreenshot.TopLeftCell.Row + 1)
maxHorizontalCells = Application.WorksheetFunction.Max( _
maxHorizontalCells, _
shpScreenshot.BottomRightCell.Column - shpScreenshot.TopLeftCell.Column + 1)
Next shpScreenshot
' set appropriate zoom level
With wsDestination
' Simulate a print area with required dimensions to get it printed to 1 page
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = _
.Range(.Cells(1, 1), .Cells(maxVerticalCells, maxHorizontalCells)).Address
' change the page setup to automatic and keep previous zoom level
' by sending keys to page setup dialog
.Activate
Dim strKeys As String
strKeys = "P" ' key "P" for first tab in that dialog
strKeys = strKeys & "%V" ' key <Alt>+<V> for automatic zoom (German, might be %A in other countries)
strKeys = strKeys & "~" ' key <Enter>
SendKeys strKeys ' send keys to following dialog
Application.Dialogs(xlDialogPageSetup).Show
Dim myZoomlevel As Double
myZoomlevel = .PageSetup.Zoom
' Reset print area, reset automatic page adaption, use previous zoom level
.PageSetup.PrintArea = ""
.PageSetup.FitToPagesWide = False
.PageSetup.FitToPagesTall = False
.PageSetup.Zoom = myZoomlevel
End With