如何将特定页面从一个pdf附加到另一个pdf？

问题描述 投票：4回答：3

目前我有将pdfs结合在一起的代码。它从我在列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)
excel vba excel-vba
3个回答
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))

More Nearly Complete Answer

好的，我知道我不应该这样做，但我们走了。我修改了你的代码，以我认为应该工作的方式工作。它不是一个完整的修订版，因为整个过程可以在一次传递中完成，并且可以消除Collection对象。以下代码中可能存在错误，因为我没有Adobe 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
1
投票

您可以尝试删除每个pdf中不需要的部分，然后将它们与sourceDoc.DeletePages(startPage, endPage)一起附加，例如：

OK = sourceDoc.Open(FilePaths(colIndex))

startPage = Range("C" & colIndex)
endPage = Range("D" & colIndex)
OK = sourceDoc.DeletePages(1, startPage - 1)
OK = sourceDoc.DeletePages(endPage - startPage + 2, sourceDoc.GetNumPages) ' just some arithmetic

Debug.Print "(" & colIndex & ") SOURCE DOC OPENED & PDDOC SET: " & OK

您只需要为C＆D列中的每一个指定startPage和endPage ...或者您可以更改此片段并根据您的喜好对其进行说明

1
投票

说明：

对于First Code，我删除了除了准系统之外的所有内容：附加到doc的文件路径和文件路径到我们获取要附加到主doc的页面的文件。

我为我们设置了一个常量并将其设置为2.我们可以将其设置为3或5等。此常量将在插入页面功能的PAGE TO END部分中传递。我有一种感觉，你会说pdf中的总页数与要追加的数量之间存在一定的关系，但这一点在OP中并不明确。

打破下来的插入物（）：

INSERTPAGES（插入开始的页码（在primaryDoc中），作为插入页面源的PDF的路径（sourcedoc途径），从（sourceDoc）开始的页面，从页面到结尾（sourceDoc），true或false是否为true也插入了书籍

代码清单：

Option Explicit

Sub AppendPDF()
Dim app                             As Object
Dim acroDoc                         As Object
Dim filePaths                       As Collection
Dim pathwayIterator                 As Range
Dim primaryDoc                      As Object
Dim OK                              As String
Dim numPages                        As Long
Dim colIndex                        As Long
Dim sourceDoc                       As Object
Const finalPage = 2

    Set app = CreateObject("Acroexch.app")
    Set acroDoc = New AcroPDDoc
    Set filePaths = New Collection

    For Each pathwayIterator In Range("A2:A100")
        If pathwayIterator.Value <> "" Then
            filePaths.Add pathwayIterator.Value2
        End If
    Next pathwayIterator

    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

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

        sourceDoc.Close
        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

代码额外：

在这里我们添加了一些。我不确定你在处理文件长度，我觉得你要将它们与要追加的页面数量联系起来。在这里，我们创建了两个集合，一个包含我们正在处理的文件的路径，另一个包含每个文件的页面数

Option Explicit

Sub AppendPDF()
Dim app                             As Object
Dim acroDoc                         As Object
Dim filePaths                       As Collection
Dim pgnumber                        As Range
Dim pageNum                         As Long
Dim FileNumPages                    As Collection
Dim pathwayIterator                 As Range
Dim primaryDoc                      As Object
Dim OK                              As String
Dim numPages                        As Long
Dim colIndex                        As Long
Dim sourceDoc                       As Object
Const finalPage = 2

    Set app = CreateObject("Acroexch.app")
    Set acroDoc = New AcroPDDoc
    Set filePaths = New Collection

    'Counts # of pages in each pdf, loads to column D.
    For Each pgnumber In Range("A2:A100")
        If Not IsEmpty(pgnumber) Then
            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
    Set filePaths = New Collection
    Set FileNumPages = New Collection

    For Each pathwayIterator In Range("A2:A100")
        If pathwayIterator.Value <> "" Then
            filePaths.Add pathwayIterator.Value2
            FileNumPages.Add Cells(pathwayIterator.Row, 4)
        End If
    Next pathwayIterator

    '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

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

        sourceDoc.Close
        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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.