将多个范围合并为一个pdf

时间:2020-09-15 13:41:59

标签: excel vba

基于一些帖子,我能够在下面的脚本中进行打印,该脚本将几个选定的范围打印到pdf文件中。但是,所有范围都打印在单独的纸上。

当前为NewRng.Address =“ A1:G9,A13:G14,A18:G37”。我认为可能需要是“ A1:G9; A13:G14; A18:G37”(由;分隔,而不是,)(?)

有人可以解释如何在一张纸上打印所选范围吗?

非常感谢您!

脚本:

   Sub CreatePDF_Selection1()

    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Dim NewRng As Range

    With ThisWorkbook.Sheets("Sheet1")
        Set rng1 = .Range("A1:G9")
        Set rng2 = .Range("A13:G14")
        Set rng3 = .Range("A18:G37")
        
        Set NewRng = .Range(rng1.Address & "," & rng2.Address & "," & rng3.Address)

        Debug.Print NewRng.Address
    
    Sheets("Sheet1").Activate
    ActiveSheet.Range(NewRng.Address).Select
    
    Sheets(Array("Sheet1")).Select

   ThisWorkbook.Sheets(Array("Sheet1")).Select
   Selection.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="U:\Sample Excel File Saved As PDF", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=False, _
    IgnorePrintAreas:=True, _
    From:=1, _
    OpenAfterPublish:=True
    End With

   End Sub

3 个答案:

答案 0 :(得分:2)

不是选择各种范围,而是隐藏不想打印的行,然后打印整个范围。

Option Explicit

Sub CreatePDF_Selection1()
   
  Dim rng1 As Range

  ThisWorkbook.Sheets("Sheet1").Activate
  Set rng1 = Range("A1:G37")
     
  Range("A10:A12").EntireRow.Hidden = True  '*** Hide rows not to print ***
  Range("A15:A17").EntireRow.Hidden = True
            
  rng1.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:="U:\Sample Excel File Saved As PDF", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=False, _
    IgnorePrintAreas:=True, _
    From:=1, _
    OpenAfterPublish:=True

  Rows("1:37").EntireRow.Hidden = False '*** Unhide hidden rows ***

End Sub 'CreatePDF_Selection1()


HTH

编辑:附加测试输出。 enter image description here

答案 1 :(得分:0)

将非连续范围导出为PDF

此解决方案使用Application.Union方法来创建要导出的范围。然后使用Range.Copy方法将范围复制到新添加的工作表中,然后从那里导出。然后,新添加的工作表将被删除。

Option Explicit

Sub CreatePDF_Selection1()
    
    Const FilePath As String = "U:\Sample Excel File Saved As PDF"
    Const SheetName As String = "Sheet1"
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' Define Copy Range.
    With wb.Worksheets(SheetName)
        Dim rng As Range
        Set rng = Union(.Range("A1:G9"), .Range("A13:G14"), .Range("A18:G37"))
    End With
    
    ' Copy Copy Range to new worksheet, export to PDF and delete new worksheet.
    With Worksheets.Add
        ' This will copy values and formats.
        rng.Copy .Range("A1")
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=FilePath, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=False, _
                             IgnorePrintAreas:=True, _
                             OpenAfterPublish:=True
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

答案 2 :(得分:0)

我找不到直接的解决方案,因此这里有一项工作。将添加一个新的工作表。内容将以连续范围复制到此处。该工作表将导出为PDF,然后删除不需要的工作表。

Sub CreatePDF_Selection1()
    Dim rng1 As Range, rng2 As Range, rng3 As Range
    Dim NewRng As Range
    
    Application.ScreenUpdating = False
    With Sheet1
        Set rng1 = .Range("A1:G9")
        Set rng2 = .Range("A13:G14")
        Set rng3 = .Range("A18:G37")
        Set NewRng = Union(rng1, rng2, rng3)
    End With
    
    'Creating test values
    rng1.Value = "Test 1"
    rng2.Value = "Test 2"
    rng3.Value = "Test 3"
    
    NewRng.Copy
    
    'adding a new sheet
    Worksheets.Add after:=Sheet1
    With ActiveSheet
        .Paste
        .ExportAsFixedFormat,  _
          Type:=xlTypePDF, _
          Filename:="U:\Sample Excel File Saved As PDF", _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=False, _
          IgnorePrintAreas:=True, _
          From:=1, _
          OpenAfterPublish:=True
        Application.DisplayAlerts = False
        .Delete 'delete the unwanted worksheet
        Application.DisplayAlerts = True
    End With
    Application.ScreenUpdating = True
End Sub