使用VBA代碼根據列值從Excel匯出到多個PDF

我有一個大型資料電子表格，我正試圖將其匯出到多個 PDF。電子表格包含手動分頁符，因為 A 列的“繼承”值發生更改。電子表格中的資料如下所示：

在電子表格中，在“Paul”和“Mary”的正上方分別有手動分頁符，以便將每個人列印在單獨的頁面上。因此，所需的輸出是在 PDF 匯出中模擬的；即從 A 列中顯示“Peter”的行到顯示“Paul”的前一行的所有內容都列印到單個 PDF 檔案中，然后從 A 列中顯示“Paul”的位置到前一行的所有內容它在另一個地方說“瑪麗”，等等。

我修改了一些在網上找到的代碼，但是如果一個人的資料跨越多個頁面（它會），它只會列印出一頁。我想問題的一部分是第二頁上不會有任何人的名字，所以不是將它保存為“Peter data.pdf”而是另存為“data.pdf”，它隨后會在整個電子表格中作業時被覆寫并遇到更多的多頁人。我還注意到 To 和 From 呼叫相同的變數 (p)，因此它限制為一頁。

Set ThisSheet = Worksheets("Sheet1")
ExportDir = "C:\Users\Julian\Export\"
NrPages = ThisSheet.HPageBreaks.Count 'This is including automatic page breaks as well as manual ones

For p = 1 To NrPages
    If p = 1 Then
        RwStart = 1
    Else
        RwStart = ThisSheet.HPageBreaks(p - 1).Location.Row
    End If

    FoundName = Replace(ThisSheet.Range("A" & RwStart).Value, "/", "-") 'Sometimes two people are grouped together and dividied with a forward slash, so changing that to a hyphen for the export name
    ExportName = FoundName & " data.pdf"

    ThisSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ExportDir & ExportName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=p, To:=p, OpenAfterPublish:=False
Next
Set ThisSheet = Nothing

用名稱填充空白單元格以便每一行都有一個名稱是不理想的。

在一個完美的世界中，它會在每次手動分頁符處輸出一個新的 PDF 并忽略所有自動分頁符。

我正在尋找某種方法來實作此邏輯：對于 A 列中的每個名稱，選擇行直到 [A 列中的下一個名稱減去 1 行] 并列印選擇。

這是可以實作的嗎？我對 VBA 的了解為零，而且我一直在盡可能地摸索。

非常感謝您的幫助。

uj5u.com熱心網友回復：

“這可以實作嗎？” - 是的。

該Range.End屬性是你在找什么。它將允許您測量 A 列中每個條目之間的空白行數。Range.End您可以創建一個回圈，瀏覽 A 列并根據它找到的每個非空白單元格構建資料的每個“頁面”。

有關詳細說明，請參閱以下代碼中的注釋：

Sub Main()
    Dim ws As Worksheet
    Set ws = ActiveSheet  ' If you want to target a specific worksheet, change this.
    
    'Export all pages to PDF
    ExportAllPages ws
End Sub

Sub ExportAllPages(ws As Worksheet)
    Const STARTING_ROW As Long = 2 'First row containing data on the sheet.
    Const NUMBER_OF_COLUMNS As Long = 4 'Number of columns containing data on the sheet.
    Const ExportDir As String = "C:\Users\Julian\Export\"
    
    'Finding the last used row of the sheet
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    
    Dim r As Long
    For r = STARTING_ROW To LastRow
        'Skimming down column A to find the next non-blank cell
        Dim PageEnd As Long
        PageEnd = ws.Cells(r, 1).End(xlDown).Row - 1
        
        'Exception: There are a series of non-blank cells in column A
        'Resolution: Set PageEnd to r instead of using .End(xlDown)
        If ws.Cells(r   1, 1) <> "" Then PageEnd = r

        'If we hit the bottom of the worksheet, trim to the last used row.
        If PageEnd > LastRow Then PageEnd = LastRow
        
        'Defining the current printable page area
        Dim CurrentPage As Range
        Set CurrentPage = ws.Range(ws.Cells(r, 1), ws.Cells(PageEnd, NUMBER_OF_COLUMNS))
        ws.PageSetup.PrintArea = CurrentPage.Address
        
        Dim FoundName As String, ExportName As String
        FoundName = Replace(ws.Cells(r, 1).Value, "/", "-") 'Sometimes two people are grouped together and dividied with a forward slash, so changing that to a hyphen for the export name
        ExportName = FoundName & " data.pdf"
        
        ws.ExportAsFixedFormat Type:=xlTypePDF, _
                               Filename:=ExportDir & ExportName, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               OpenAfterPublish:=False
        
        'Moving the loop index, skipping the rows of the current page
        r = PageEnd
    Next
End Sub

標籤：

上一篇：使用WithRange("F15")時AddComment不起作用

下一篇：隨著RubberduckVBE的添加，有沒有辦法在模塊級別禁用檢查？