All columns of excelsheet are not fitted in same page of pdf; while converting using Excel VBA

Question

Am trying to convert microsoft excel file with large number of columns (70+) into pdf using a Excel VBA code.

In active workbook, am trying to save 'Sheet1' to PDF format at required path. I have the following code.

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

When am running the VBA code and saving the pdf file, I see that; the whole excelsheet is not fitted in same page. It's displaying some content in next page.

(Only few columns appear in first page, remaining appear on next page and so on..).

I checked with How to publish a wide worksheet in PDF format?.

But, setting page layout to landscape and converting excel file manually to PDF; also displays some columns in next pages.

There are many Free Excel to PDF Converters available online, which give me same results.

Is there any function available in VBA, through which I can fit all the columns in a single page of PDF?

Answer 1

The problem is with the Page Setup settings, I have done some minor changes to your code and added a procedure to perform the page setup settings, when launching the procedure you can select the paper size, however be aware the minimum zoom allowed is 10% (see PageSetup Members (Excel)). Therefore, if even at 10% the Print Area does not fit in one page I suggest to chose a larger paper size (i.e. A3) to generate an one page PDF, then when printing the Pdf select fit to page. The procedure also gives you the change to play with the margins, when generating PDF's I set all margins at 0, but you can changed as it fits your goals.

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

Answer 2

add this to your code, it will force everything to print on one sheet wide, but still let it print over multiple sheets tall

With Worksheets("Sheet1").PageSetup
    .FitToPagesWide = 1
    .FitToPagesTall = False
End With

also set your margins to "Narrow"

Answer 3

First select the range you want to print and set it as PrintArea. And then run this code, this work for me with an 79 columns 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

Answer 4

The problem is that you need to Select the UsedRange and then use 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

EDIT:

The problem was the PageSetupbecasue each page size has a maximum pixel limit as you were heading towards in your comment.

The Page Size is set to Oversize A0 which should more than cater for your 100x1500 UsedRange. Here you change the page size with the FitToPages... = 1 to check that your Range is within the print lines.

The FitToPagesWide and FitToPagesTall is to fit everything onto one page.

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

Note that the Page will appear Blank, you will need to Zoom in alot to view the data