Все столбцы excelsheet не установлены на одной странице pdf; при конвертации с использованием Excel VBA

Я пытаюсь преобразовать файл excel microsoft с большим количеством столбцов (70+) в pdf с помощью кода Excel VBA.

В активной книге я пытаюсь сохранить "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, доступных в Интернете, которые дают мне те же результаты.

Есть ли какая-либо функция, доступная в VBA, через которую я могу поместить все столбцы на одной странице PDF?

+6
источник поделиться
4 ответа

Проблема заключается в настройках Page Setup, я внес некоторые незначительные изменения в ваш код и добавил процедуру для настройки параметров настройки страницы, при запуске процедуры вы можете выбрать размер бумаги, однако имейте в виду, что минимальное масштабирование составляет 10% (см. PageSetup Members (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
+3
источник

добавьте это в свой код, это заставит все печатать на одном листе в ширину, но все же пусть оно печатает на нескольких листах высотой

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

также задайте свои поля "Узкий"

+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
+1
источник

Проблема в том, что вам нужно выбрать 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

EDIT:

Проблема заключалась в 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

Обратите внимание, что страница будет пуста, вам нужно будет увеличить масштаб, чтобы просмотреть данные

0
источник

Посмотрите другие вопросы по меткам или Задайте вопрос