如何将特定页面从一个pdf追加到另一个pdf? [英] How can I append specific pages from one pdf to another pdf?

问题描述

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

Currently I have code which combines pdfs together. It takes all pages from each file I specify in Column A3:A5 and appends to A2.

可以说我所有的pdf都有5页.但是，如果我只想获取前3个A3，完整5页的A4和1页A5怎么办?

Lets say all my pdfs have 5 pages each. However what If I want to only take the first 3 A3, and full 5 pages of A4, and 1 page A5?

我也不需要在页面之间进行指定，即A3的2，4和5.它将始终保持顺序，即1-3或1-5或1-2.

Also I don't need to specify in between pages, ie 2 , 4 and 5 of A3. It will always be in order, ie 1-3 or 1-5 or 1-2.

我有一个计数器，该计数器已经可以获取页数

I have a counter that gets the number of pages already

  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

对于实现此目标的任何帮助，将不胜感激.

Any help on how to achieve this would be appreciated.

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

'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)

推荐答案

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

请参阅我对您问题的评论.如果这是正确的，则可以解决此问题:

See my comment on your question. If that is accurate, this may fix the problem:

添加:

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))

---

更多近乎完整的答案

好的，我知道我不应该这样做，但是我们开始吧.我已经修改了您的代码，使其能够按照我认为的方式工作.这不是一个完整的修订版，因为整个过程可以一次完成，而集合对象可以被淘汰.以下代码中可能存在错误，因为我没有Adobe Acrobat SDK.但是，我认为它可以使您比以前更紧密，并且可以将所有内容放置在适当的位置.您应该可以从此处进行任何调试:

Okay, I know I shouldn't do this, but here we go. I have revised your code to work the way I think it should work. It is not a complete revision, because the whole thing could be doing in one pass and the Collection objects could be eliminated. There may be bugs in the following code, because I don't have the Adobe Acrobat SDK. But, I think it gets you closer than you were and it puts everything in place. You should be able to do any debugging from here:

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

这篇关于如何将特定页面从一个pdf追加到另一个pdf?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！