Использование VBA для печати данных из Excel в PDF - PullRequest
Новая
       45

Использование VBA для печати данных из Excel в PDF

1 голос
/ 26 июня 2019

Казалось бы, очень простой вопрос, но у меня есть таблица Excel, которая использует код vba, чтобы сделать снимок экрана чего-либо, вставляет его во вкладку «Снимок экрана» и затем экспортирует эту вкладку в файл PDF.Моя проблема в том, что разрыв страницы, который я передаю, не совпадает с пунктирной линией разрыва страницы, которая, кажется, создается по умолчанию (?) ...

Раздел кода: 

Set Screen = Sheets("Screenshots")
Set Block = Sheets("BlockChart")
Set CopyRangeBlock = Block.Range("A1:N51")
Set PasteRange = Screen.Cells(1, 1)
Application.DisplayStatusBar = True
CopyRangeBlock.CopyPicture xlScreen, xlPicture
DoEvents
Screen.Paste Destination:=PasteRange
DoEvents
Sheets("Screenshots").Rows(52).PageBreak = xlPageBreakManual
Application.CutCopyMode = False

Диапазон данных для снимка экрана - от «A1: N: 51», и поэтому я помещаю разрыв страницы в строке 52. Однако пунктирная линия разрыва страницы появляется (по-видимому, по умолчанию) в строке 50.Экспорт в PDF и производит пустые страницы.Это особенно актуально, когда я перебираю код для создания нескольких страниц в формате PDF.Как сделать так, чтобы пунктирная линия либо не появлялась, либо соответствовала заданному мною разрыву страницы, чтобы я не получал лишних пустых страниц?

Пример:

enter image description here

Просто, чтобы повторить точку, весь рабочий лист содержит предварительно определенные пунктирные линии для области печати.По сути, я хочу изменить их (с помощью ручных разрывов или чего-то подобного), чтобы каждая страница, напечатанная в формате PDF, имела нестандартный размер, соответствующий скриншоту данных.

enter image description here

1 Ответ

0 голосов
/ 27 июня 2019

С помощью следующего кода вы можете вставить несколько примеров диапазонов в виде скриншотов на лист назначения, каждый с разрывом страницы между ними.

Я оставил одну строку пустой до и после каждого снимка экрана (причина: когда границафигуры помещается непосредственно на разрыв страницы, граница может быть напечатана и на соседней странице).

Пожалуйста, измените уровень масштабирования в последней строке кода, чтобы получить даже самый большой скриншот, напечатанный на 1 странице.(например, 54%).Если вы хотите рассчитать его автоматически, см. Вторую часть кода этого ответа. 

Private Sub CollectScreenshots()
    Dim wsSource As Worksheet, wsDestination As Worksheet
    Dim rngExampleRanges As Range
    Dim rngCopy As Range
    Dim rowPaste As Long
    Dim shpScreenshot As Shape

    Dim dlg As Dialog

    Application.DisplayStatusBar = True

    Set wsSource = Sheets("BlockChart")
    Set rngExampleRanges = wsSource.Range("A1:N51, A52:B53, C60:E99")

    Set wsDestination = Sheets("Screenshots")

    ' Copy all ranges as screenshot into destination worksheet:
    rowPaste = 1
    With wsDestination
        .ResetAllPageBreaks
        For Each rngCopy In rngExampleRanges.Areas
            rngCopy.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            DoEvents

            If rowPaste > 1 Then .HPageBreaks.Add Before:=.Rows(rowPaste)
            .Paste Destination:=.Cells(rowPaste + 1, 1), Link:=False
            DoEvents

            Set shpScreenshot = .Shapes(.Shapes.Count)
            rowPaste = shpScreenshot.BottomRightCell.Row + 1
        Next rngCopy
    End With
    Application.CutCopyMode = False

    ' set appropriate zoom level
    wsDestination.PageSetup.Zoom = 54

End Sub

Автоматический уровень масштабирования

Если вы хотите, чтобы Excel рассчитал оптимальный уровень масштабирования,это немного сложнее.

Если у вас есть диапазон ячеек, например, A1: N51, который должен быть напечатан на 1 странице, тогда вы можете установить параметры диалогового окна страницы следующим образом:

  • определить область печати как A1: N51
  • установить масштабирование на ширину 1 страницы и высоту 1 страницы
  • Затем вы можете визуально увидеть рассчитанный уровень масштабирования в диалоговом окне настройки страницы.

К сожалению, вы не можете прочитать этот уровень масштабирования напрямую через VBA, так как Worksheet.PageSetup.Zoom в этом случае возвращает только False.Если вы призываете Excel использовать уровень масштабирования, например, установив FitToPagesWide на False, Excel рассчитывает новый уровень масштабирования.

Чтобы прочитать рассчитанный уровень масштабирования, необходимо отправить сочетание клавиш надиалог настройки страницы.Чтобы получить правильное сочетание клавиш для этого, проверьте в диалоговом окне настройки страницы, какое сочетание клавиш используется для уровня масштабирования.В моей немецкой версии Excel это Alt + V .

Затем замените последнюю строку кода сверху следующим образом: 

    ' get cell dimensions of the largest screenshot:
    Dim maxVerticalCells, maxHorizontalCells
    For Each shpScreenshot In wsDestination.Shapes
        maxVerticalCells = Application.WorksheetFunction.Max( _
            maxVerticalCells, _
            shpScreenshot.BottomRightCell.Row - shpScreenshot.TopLeftCell.Row + 1)
        maxHorizontalCells = Application.WorksheetFunction.Max( _
            maxHorizontalCells, _
            shpScreenshot.BottomRightCell.Column - shpScreenshot.TopLeftCell.Column + 1)
    Next shpScreenshot

    ' set appropriate zoom level
    With wsDestination

        ' Simulate a print area with required dimensions to get it printed to 1 page
        .PageSetup.Zoom = False
        .PageSetup.FitToPagesWide = 1
        .PageSetup.FitToPagesTall = 1
        .PageSetup.PrintArea = _
            .Range(.Cells(1, 1), .Cells(maxVerticalCells, maxHorizontalCells)).Address

        ' change the page setup to automatic and keep previous zoom level
        ' by sending keys to page setup dialog
        .Activate

        Dim strKeys As String
        strKeys = "P"               ' key "P" for first tab in that dialog
        strKeys = strKeys & "%V"    ' key <Alt>+<V> for automatic zoom (German, might be %A in other countries)
        strKeys = strKeys & "~"     ' key <Enter>
        SendKeys strKeys            ' send keys to following dialog
        Application.Dialogs(xlDialogPageSetup).Show
        Dim myZoomlevel As Double
        myZoomlevel = .PageSetup.Zoom

        ' Reset print area, reset automatic page adaption, use previous zoom level
        .PageSetup.PrintArea = ""
        .PageSetup.FitToPagesWide = False
        .PageSetup.FitToPagesTall = False
        .PageSetup.Zoom = myZoomlevel
    End With
...