簡體   English   中英

將多個范圍合並在一個 pdf 中

[英]Combine Multiple Ranges in one pdf

根據一些帖子,我能夠制作以下腳本,將幾個選定的范圍打印到 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

而不是選擇各種范圍,只需隱藏您不想打印的行,然后打印整個范圍。

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

編輯:附加測試輸出。 在此處輸入圖片說明

將非連續范圍導出為 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

我找不到直接的解決方案,所以這里有一項工作。 將添加一個新工作表。 內容將作為連續范圍復制到那里。 該工作表將導出為 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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM