多数の列(70以上)を含むMicrosoftExcelファイルをExcelVBAコードを使用して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ファイルを保存すると、次のことがわかります。エクセルシート全体が同じページに収まらない。次のページにいくつかのコンテンツを表示しています。
(最初のページに表示される列はわずかで、残りは次のページに表示されます。など)。
幅の広いワークシートをPDF形式? で公開する方法)で確認しました。
ただし、ページレイアウトを横向きに設定し、Excelファイルを手動でPDFに変換します。また、次のページにいくつかの列を表示します。
オンラインで利用できる無料のExcelからPDF Converter)がたくさんあり、同じ結果が得られます。
PDFの1ページにすべての列を収めることができるVBAで利用可能な関数はありますか?
問題はページ設定設定にあります。コードにいくつかの小さな変更を加え、ページ設定設定を実行する手順を追加しました。手順を起動すると、用紙サイズを選択できますが、許可される最小ズームは10%であることに注意してください。 ( PageSetupメンバー(Excel) )を参照してください。したがって、10%でも印刷領域が1ページに収まらない場合は、より大きな用紙サイズ(A3など)を選択して1ページのPDFを生成し、PDFを印刷するときに[ページに収まる]を選択することをお勧めします。この手順では、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
まず、印刷する範囲を選択し、PrintAreaとして設定します。そして、このコードを実行すると、79列のシートでこれが機能します
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
これをコードに追加すると、すべてが1枚の幅で印刷されますが、それでも複数の高さで印刷されます。
With Worksheets("Sheet1").PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With
また、マージンを「狭い」に設定します
問題は、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
でした。なぜなら、コメントで向かっていたときに、各ページサイズに最大ピクセル制限があるからです。
ページサイズはオーバーサイズA0に設定されており、100x1500 UsedRange
以上に対応する必要があります。ここでは、FitToPages... = 1
を使用してページサイズを変更し、Range
が印刷行内にあることを確認します。
FitToPagesWide
とFitToPagesTall
は、すべてを1つのページに収めるためのものです。
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
ページが空白で表示されることに注意してください。データを表示するには、ズームインする必要があります