excelsheet 的所有列不适合 pdf 的同一页；使用 Excel VBA 转换时
All columns of excelsheet are not fitted in same page of pdf; while converting using Excel VBA
我正在尝试使用 Excel VBA 代码将包含大量列 (70+) 的 Microsoft excel 文件转换为 pdf。
在活动工作簿中，我正在尝试将 'Sheet1' 保存为所需路径中的 PDF 格式。我有以下代码。
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
With ActiveWorkbook
.Worksheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
fileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
End Sub
运行 VBA 代码和保存 pdf 文件时，我看到了；整个 excelsheet 不适合放在同一页中。它正在下一页显示一些内容。
（只有几列出现在第一页，其余出现在下一页等等..）。
我检查了How to publish a wide worksheet in PDF format?。
但是，将页面布局设置为横向并将 excel 文件手动转换为 PDF；还会在下一页中显示一些列。
网上有很多免费的Excel转PDF转换器，它们给我的结果是一样的。
VBA 中有什么功能可以让我将所有列都放在一页 PDF 中吗？
将此添加到您的代码中，它将强制所有内容打印在一个 sheet 宽上，但仍然让它打印多个 sheet 高
With Worksheets("Sheet1").PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With
同时将边距设置为 "Narrow"
问题出在页面设置设置上，我对您的代码做了一些小改动，并添加了一个程序来执行页面设置设置，启动该程序时您可以 select 纸张大小，但是请注意，允许的最小缩放比例为 10% （参见 PageSetup Members (Excel)）。因此，即使是 10% 的打印区域也不适合一页，我建议选择更大的纸张尺寸（即 A3）来生成一页 PDF，然后在打印 Pdf select 时适合页面。该过程还为您提供了改变边距的方式，在生成 PDF 时我将所有边距设置为 0，但您可以根据自己的目标进行更改。
Sub Wsh_LargePrintArea_To_Pdf()
Dim WshTrg As Worksheet
Dim sFileName As String
sFileName = Application.GetSaveAsFilename( _
InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If sFileName <> "False" Then
Rem Set Worksheet Target
Set WshTrg = ActiveWorkbook.Worksheets("Sheet1")
Rem Procedure Update Worksheet Target Page Setup
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperLetter)
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA4)
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'If the Print Still don't fit in one page then use a the largest Paper Size (xlPaperA3)
'When printing the Pdf you can still selet to fix to the physical paper size of the printer.
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA3)
'This is the largest paper i can see in my laptop is 86.36 cm x 111.76 cm
Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperEsheet)
Rem Export Wsh to Pdf
WshTrg.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=sFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End Sub
Sub Wsh_Print_Setting_OnePage(WshTrg As Worksheet, ePaperSize As XlPaperSize)
On Error Resume Next
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
'.Orientation = xlLandscape
.Orientation = xlPortrait
.PaperSize = ePaperSize
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
End Sub
问题是你需要Select UsedRange然后使用Selection.ExportAsFixedFormat
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End Sub
编辑：
问题出在 PageSetup 因为每个页面大小都有最大像素限制，正如您在评论中所说的那样。
页面大小设置为 Oversize A0，这应该足以满足您的 100x1500 UsedRange。在这里，您使用 FitToPages... = 1 更改页面大小，以检查您的 Range 是否在打印行内。
FitToPagesWide 和 FitToPagesTall 是将所有内容都放在一页上。
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Suspending Communicaiton with Printer to Edit PageSetup via Scripting
Application.PrintCommunication = False
'Setting Page Setup
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
' Setting Page Size to 92x92 inch Should cater for your data
.PaperSize = 159
End With
'Enabling Communicaiton with Printer
Application.PrintCommunication = True
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
End If
End Sub
请注意，页面会显示为空白，您需要放大很多才能查看数据
首先select你要打印的范围，设置为PrintArea。然后 运行 这段代码，这对我来说有 79 列 sheet
Sub saveAsPDF()
Dim MyPath
Dim MyFolder
With Sheet1.PageSetup
'.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.BottomMargin = 0
.TopMargin = 0
.RightMargin = 0
.LeftMargin = 0
End With
MyPath = ThisWorkbook.Path
MyFolder = Application.GetSaveAsFilename(MyPath, "PDF Files (*.pdf),*.pdf")
If MyFolder = False Then Exit Sub
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=MyFolder, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
我正在尝试使用 Excel VBA 代码将包含大量列 (70+) 的 Microsoft excel 文件转换为 pdf。
在活动工作簿中，我正在尝试将 'Sheet1' 保存为所需路径中的 PDF 格式。我有以下代码。
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
With ActiveWorkbook
.Worksheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
fileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
End Sub
运行 VBA 代码和保存 pdf 文件时，我看到了；整个 excelsheet 不适合放在同一页中。它正在下一页显示一些内容。
（只有几列出现在第一页，其余出现在下一页等等..）。
我检查了How to publish a wide worksheet in PDF format?。
但是，将页面布局设置为横向并将 excel 文件手动转换为 PDF；还会在下一页中显示一些列。
网上有很多免费的Excel转PDF转换器，它们给我的结果是一样的。
VBA 中有什么功能可以让我将所有列都放在一页 PDF 中吗？
将此添加到您的代码中，它将强制所有内容打印在一个 sheet 宽上，但仍然让它打印多个 sheet 高
With Worksheets("Sheet1").PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With
同时将边距设置为 "Narrow"
问题出在页面设置设置上，我对您的代码做了一些小改动，并添加了一个程序来执行页面设置设置，启动该程序时您可以 select 纸张大小，但是请注意，允许的最小缩放比例为 10% （参见 PageSetup Members (Excel)）。因此，即使是 10% 的打印区域也不适合一页，我建议选择更大的纸张尺寸（即 A3）来生成一页 PDF，然后在打印 Pdf select 时适合页面。该过程还为您提供了改变边距的方式，在生成 PDF 时我将所有边距设置为 0，但您可以根据自己的目标进行更改。
Sub Wsh_LargePrintArea_To_Pdf()
Dim WshTrg As Worksheet
Dim sFileName As String
sFileName = Application.GetSaveAsFilename( _
InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If sFileName <> "False" Then
Rem Set Worksheet Target
Set WshTrg = ActiveWorkbook.Worksheets("Sheet1")
Rem Procedure Update Worksheet Target Page Setup
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperLetter)
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA4)
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'If the Print Still don't fit in one page then use a the largest Paper Size (xlPaperA3)
'When printing the Pdf you can still selet to fix to the physical paper size of the printer.
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA3)
'This is the largest paper i can see in my laptop is 86.36 cm x 111.76 cm
Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperEsheet)
Rem Export Wsh to Pdf
WshTrg.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=sFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End Sub
Sub Wsh_Print_Setting_OnePage(WshTrg As Worksheet, ePaperSize As XlPaperSize)
On Error Resume Next
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
'.Orientation = xlLandscape
.Orientation = xlPortrait
.PaperSize = ePaperSize
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
End Sub
问题是你需要Select UsedRange然后使用Selection.ExportAsFixedFormat
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End Sub
编辑：
问题出在 PageSetup 因为每个页面大小都有最大像素限制，正如您在评论中所说的那样。
页面大小设置为 Oversize A0，这应该足以满足您的 100x1500 UsedRange。在这里，您使用 FitToPages... = 1 更改页面大小，以检查您的 Range 是否在打印行内。
FitToPagesWide 和 FitToPagesTall 是将所有内容都放在一页上。
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Suspending Communicaiton with Printer to Edit PageSetup via Scripting
Application.PrintCommunication = False
'Setting Page Setup
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
' Setting Page Size to 92x92 inch Should cater for your data
.PaperSize = 159
End With
'Enabling Communicaiton with Printer
Application.PrintCommunication = True
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
End If
End Sub
请注意，页面会显示为空白，您需要放大很多才能查看数据
首先select你要打印的范围，设置为PrintArea。然后 运行 这段代码，这对我来说有 79 列 sheet
Sub saveAsPDF()
Dim MyPath
Dim MyFolder
With Sheet1.PageSetup
'.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.BottomMargin = 0
.TopMargin = 0
.RightMargin = 0
.LeftMargin = 0
End With
MyPath = ThisWorkbook.Path
MyFolder = Application.GetSaveAsFilename(MyPath, "PDF Files (*.pdf),*.pdf")
If MyFolder = False Then Exit Sub
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=MyFolder, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub