vba - 如何将一个 pdf 中的特定页面附加到另一 pdf 中？

Question

目前我有将 pdf 组合在一起的代码。它从我在 A3:A5 列中指定的每个文件中获取所有页面，并将其附加到 A2。

假设我所有的 pdf 文件各有 5 页。但是，如果我只想取前 3 页 A3、完整 5 页 A4 和 1 页 A5，该怎么办？

此外，我不需要在页面之间指定，即 A3 的 2 、 4 和 5 。它总是按顺序排列，即 1-3 或 1-5 或 1-2。

我有一个计数器可以获取页数

  Dim i As Long, pgnumber As Range
    For Each pgnumber In Range("A2:A100")
    If Not IsEmpty(pgnumber) Then
    i = i + 1
    AcroDoc.Open pgnumber
    PageNum = AcroDoc.GetNumPages
    Cells(pgnumber.Row, 4) = PageNum
    End If
    AcroDoc.Close
    Next pgnumber

完整代码:

Sub main3()

    Set app = CreateObject("Acroexch.app")

    Dim FilePaths As Collection
    Set FilePaths = New Collection
    Dim AcroDoc As Object
    Set AcroDoc = New AcroPDDoc

    'Counts # of pages in each pdf, loads to column D.

    Dim i As Long, pgnumber As Range
    For Each pgnumber In Range("A2:A100")
    If Not IsEmpty(pgnumber) Then
    i = i + 1
    AcroDoc.Open pgnumber
    PageNum = AcroDoc.GetNumPages
    Cells(pgnumber.Row, 4) = PageNum
    End If
    AcroDoc.Close
    Next pgnumber


    'Append to this file, ideally will be a front page to append to, commented out for now.

    'FilePaths.Add "\path\name\here"

    'Active or not feature in Column B, Specify Yes to include in combination, no to exclude

    Dim cell As Range
    For Each cell In Range("A2:A100")
    If cell.Offset(0, 1).Value2 <> "No" Then FilePaths.Add cell.Value2
    Next cell


    'Combine files which are listed in Column A.

    Set primaryDoc = CreateObject("AcroExch.PDDoc")
    OK = primaryDoc.Open(FilePaths(1))
    Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK

    For colIndex = 2 To FilePaths.Count
        numPages = primaryDoc.GetNumPages() - 1

        Set sourceDoc = CreateObject("AcroExch.PDDoc")
        OK = sourceDoc.Open(FilePaths(colIndex))
        Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK

        numberOfPagesToInsert = sourceDoc.GetNumPages

        OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, numberOfPagesToInsert, False)
        Debug.Print "(" & colIndex & ") PAGES INSERTED SUCCESSFULLY: " & OK

        Set sourceDoc = Nothing
    Next colIndex

    OK = primaryDoc.Save(PDSaveFull, FilePaths(1))
    Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK

    Set primaryDoc = Nothing
    app.Exit
    Set app = Nothing
    MsgBox "DONE"
End Sub

任何有关如何实现这一目标的帮助将不胜感激。

尝试了以下代码，但没有任何效果:

'attempt to do start and end page in col E and F.

    startPage = Range("E" & colIndex)
    endPage = Range("F" & colIndex)
    OK = sourceDoc.DeletePages(1, startPage - 1)
    OK = sourceDoc.DeletePages(endPage - startPage + 2, sourceDoc.GetNumPages)

Answer 1

下面有一个更接近完整的答案

请参阅我对您的问题的评论。如果这是准确的，这可能会解决问题:

添加:

Dim FileRows As Collection
Set FileRows = New Collection

改变

If cell.Offset(0, 1).Value2 <> "No" Then FilePaths.Add cell.Value2

致:

If cell.Offset(0, 1).Value2 <> "No" Then
    FilePaths.Add cell.Value2
    FileRows.Add cell.Row
Endif

更改:

startPage = Range("E" & colIndex)
endPage = Range("F" & colIndex)

致:

startPage = Range("E" & FileRows(colIndex))
endPage = Range("F" & FileRows(colIndex))

<小时/> 更接近完整的答案

好吧，我知道我不应该这样做，但我们开始吧。我已经修改了您的代码，使其按照我认为应该的方式工作。这不是一个完整的修订，因为整个事情可以一次完成，并且 Collection 对象可以被消除。以下代码可能存在错误，因为我没有 Adob​​e Acrobat SDK。但是，我认为它让你比以前更接近，并且让一切都就位。您应该能够从这里进行任何调试:

Sub CompileDocuments()

    Dim acroExchangeApp as Object   ' Needed because?
    Dim filePaths As Collection     ' Paths for PDFs to append
    Dim fileRows As Collection      ' Row numbers PDFs to append
    Dim fileIndex as Long           ' For walking through the collections
    Dim acroDoc As AcroPDDoc        ' Manages imported PDFs
    Dim sourceDoc as Object         ' Manages imported PDFs (Same as above?)
    Dim primaryDoc As Object        ' Everything gets appended to this
    Dim importPath As Range         ' Cell containing a PDF to append
    Dim pageCount As Long           ' Total pages in an appendable PDF
    Dim insertPoint as Long         ' PDFs will be appended after this page in the primary Doc
    Dim startPage as Long           ' First desired page of appended PDF
    Dim endPage as Long             ' Last desired page of appended PDF  

    ' Initialize
    Set filePaths = New Collection
    Set fileRows = New Collection
    Set acroDoc = New AcroPDDoc
    Set acroExchangeApp = CreateObject("Acroexch.app")
    Set primaryDoc = CreateObject("AcroExch.PDDoc")

    ' Pass through rows setting page numbers and capturing paths
    For Each importPath In Range("A2:A100")

        ' Put the page count of each PDF document in column D
        If Not IsEmpty(importPath) Then
            acroDoc.Open importPath
            pageCount = acroDoc.GetNumPages
            importPath.OffSet(0,3) = pageCount
            acroDoc.Close
        End If
        Set acroDoc = Nothing

        ' Remember which documents to append and the row on which they appear
        ' Skipping any rows with "No" in column B
        If importPath.Offset(0, 1).Value2 <> "No" Then
            filePaths.Add importPath.Value2
            fileRows.Add  importPath.Row
        End If

    Next importPath

    ' Combine all file listed in Column A.
    ' Start by opening the file in A2.
    OK = primaryDoc.Open(filePaths(1))
    Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK

    ' Loop through the remaining files, appending pages to A2
    ' Note that columns E and F define the desired pages to extract from
    '   the appended document.

    For fileIndex = 2 To filePaths.Count

        ' Pages will be added after this insert point
        insertPoint = primaryDoc.GetNumPages() - 1

        ' Open the source document
        Set sourceDoc = CreateObject("AcroExch.PDDoc")
        OK = sourceDoc.Open(filePaths(fileIndex))
        Debug.Print "(" & fileIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK

        ' Get start and end pages
        startPage = Range("E" & CStr(fileRows(fileIndex))).Value
        endPage = Range("F" & CStr(fileRows(fileIndex))).Value

        OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage-startPage+1, False)
        Debug.Print "(" & fileIndex & ") " & endPage-startPage+1 & " PAGES INSERTED SUCCESSFULLY: " & OK

        Set sourceDoc = Nothing

    Next fileIndex

    OK = primaryDoc.Save(PDSaveFull, filePaths(1))
    Debug.Print "primaryDoc SAVED PROPERLY: " & OK

    Set primaryDoc = Nothing
    acroExchangeApp.Exit
    Set acroExchangeApp = Nothing

    MsgBox "DONE"

End Sub