时间戳

首页 > 解决方案 > 将多个范围转换为单个 PDF，范围分开

excel - 将多个范围转换为单个 PDF，范围分开

问题描述

我将不同工作表上的多个范围转换为单个 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

ws2 的 PrintArea 范围创建一个范围。

如何分隔范围以使输出是三个范围而不是一个？

标签： excelvba

解决方案

Export to PDF

  • The solution inserts a new worksheet and copies the ranges to it. Then it exports the new worksheet to PDF and deletes the new worksheet.

Sheet Module e.g. Sheet1 (where the command button is)

Option Explicit

Private Sub CommandButton1_Click()
    exportToPDF
End Sub

Standard Module e.g. Module1

Option Explicit

Sub exportToPDF()
    
    ' Define constants.
    Const Gap As Long = 0
    Const vFile As String = "F:\Test\Export.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

Populate Data (Standard Module)

To quickly see what the code does:

  • Create a workbook containing worksheets Sheet1 and Sheet2.
  • Copy all three codes appropriately.
  • Run populateData.
  • Run exportPDF.

The Code

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

推荐阅读