Блог

Я конвертирую несколько диапазонов на разных листах в один PDF-файл.

 Private Sub CommandButton1_Click()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim vFile As Variant
    Dim sFile As String

    Set ws1 = Worksheets("Sheet1")
    ws1.PageSetup.PrintArea = "B2:K51"

    Set ws2 = Worksheets("Sheet2")
    ws2.PageSetup.PrintArea = "A3:J52, J3:S52, S3:AE52"

    Worksheets(Array(ws1.Name, ws2.Name)).Select
    ActiveSheet.ExportAsFixedFormat _
      Type:=xlTypePDF, _
      Filename:=vFile, _
      Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=False

    MsgBox "PDF file has been created."
End If

End Sub
  

Диапазон printArea для ws2 создает единый диапазон.

Как мне разделить диапазоны, чтобы на выходе было три диапазона вместо одного?

Экспорт в PDF

• Решение вставляет новый лист и копирует в него диапазоны. Затем он экспортирует новый рабочий лист в PDF и удаляет новый рабочий лист.

Например, модуль листа Sheet1 (где находится кнопка command)

 Option Explicit

Private Sub CommandButton1_Click()
    exportToPDF
End Sub
  

Стандартный модуль, например Module1

 Option Explicit

Sub exportToPDF()
    
    ' Define constants.
    Const Gap As Long = 0
    Const vFile As String = "F:TestExport.pdf"
    Dim Ranges1 As Variant
    Ranges1 = Array("B2:K51")
    Dim Ranges2 As Variant
    Ranges2 = Array("A3:J52", "J3:S52", "S3:AE52")
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' Define worksheets.
    Dim ws1 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Dim ws2 As Worksheet
    Set ws2 = Worksheets("Sheet2")
    Dim ws3 As Worksheet
    Set ws3 = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    ' Copy ranges from first to third worksheet.
    Dim rng As Range
    Dim CurrRow As Long
    CurrRow = 1
    Dim j As Long
    Dim RowsCount As Long
    Dim ColsCount As Long
    For j = LBound(Ranges1) To UBound(Ranges1)
        Set rng = ws1.Range(Ranges1(j))
        rng.Copy
        ws3.Cells(CurrRow, 1).PasteSpecial xlPasteValues
        ws3.Cells(CurrRow, 1).PasteSpecial xlFormats
        If ColsCount < rng.Columns.Count Then
            ColsCount = rng.Columns.Count
        End If
        CurrRow = CurrRow   rng.Rows.Count   Gap
    Next j
    
    ' Copy ranges from second to third worksheet.
    For j = LBound(Ranges2) To UBound(Ranges2)
        Set rng = ws2.Range(Ranges2(j))
        rng.Copy
        ws3.Cells(CurrRow, 1).PasteSpecial xlPasteValues
        ws3.Cells(CurrRow, 1).PasteSpecial xlFormats
        If ColsCount < rng.Columns.Count Then
            ColsCount = rng.Columns.Count
        End If
        CurrRow = CurrRow   rng.Rows.Count   Gap
    Next j
   
    ' Export and close third worksheet.
    With ws3
        Set rng = .Range("A1").Resize(CurrRow - Gap - 1, ColsCount)
        rng.Columns.AutoFit
        .PageSetup.PrintArea = rng.Address
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=vFile, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=False, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=True
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
    ' Inform user.
    MsgBox "PDF file has been created."
    
End Sub
  

Заполнение данных (стандартный модуль)

Чтобы быстро увидеть, что делает код:

• Создайте рабочую книгу, содержащую рабочие листы Sheet1 и Sheet2 .
• Скопируйте все три кода соответствующим образом.
• Выполнить populateData .
• Выполнить exportPDF .

Код

 Private Sub populateData()
    With [Sheet1!B2:K51]
        .Formula = "=ROW()amp;""|""amp;COLUMN()"
        .Interior.ColorIndex = 6
    End With
    With [Sheet2!A3:AE52]
        .Formula = "=ROW()amp;""|""amp;COLUMN()"
        .Interior.ColorIndex = 8
    End With
End Sub