excelsheet的所有列都没有安装在pdf的同一页面中; 使用Excel VBA进行转换时

Question

我试图使用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不适合同一页面.它在下一页显示了一些内容.

(第一页只显示少数列,剩余显示在下一页,依此类推......).

我查看了如何发布PDF格式的宽工作表？.

但是,将页面布局设置为横向并将excel文件手动转换为PDF; 还会在下一页显示一些列.

有许多免费Excel到PDF转换器可在线获得,这给我相同的结果.

VBA中是否有可用的功能,通过它我可以将所有列放在PDF的单页中？

Answer 1

首先选择要打印的范围，并将其设置为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

Answer 2

问题在于页面设置设置，我对您的代码做了一些细微的更改，并添加了一个执行页面设置设置的过程，启动该过程时您可以选择纸张尺寸，但请注意允许的最小缩放为 10% （请参阅PageSetup 成员 (Excel)）。因此，如果即使是 10% 打印区域也无法容纳在一页中，我建议选择较大的纸张尺寸（即 A3）来生成一页 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