Question

我将acrobat xi pro和vba结合使用来合并我的pdf文件。

我有一个代码，可以使用在此处找到的acrobat api将pdf页面附加到一起： https://wwwimages2.adobe.com/content/dam/acom/en/devnet/acrobat/pdfs/iac_api_reference.pdf

但是，我试图为页面自动编号，或者添加自定义保存的页眉和页脚设置并应用于所有页面。

这是我的代码：

   Dim acroExchangeApp As Object
    Set app = CreateObject("Acroexch.app")

    Dim filePaths As Collection     'Paths for PDFS to append
    Set filePaths = New Collection
    Dim fileRows As Collection      'Row numbers PDFs to append
    Set fileRows = New Collection
    Dim sourceDoc As Object
    Dim primaryDoc As Object        ' PrimaryDoc is what we append too
    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
    Dim colIndex As Long            '
    Dim numPages As Long
    Dim acroDoc As Object
    Set acroDoc = New AcroPDDoc


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

    For colIndex = 2 To filePaths.count
        query_start_time = time()
        start_memory = GetWorkingMemoryUsage

        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

        'inserts pages
        acroDoc.Open source_file_name

        insertPoint = acroDoc.GetNumPages - 1


        If endPage > 1 Then
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage & " PAGES INSERTED SUCCESSFULLY: " & OK
        Else
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage + 1, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage + 1 & " PAGES INSERTED SUCCESSFULLY: " & OK
        End If


           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

任何人都可以帮忙吗？

Answer 1

在@NiH上他在SO Adding page numbers to pdf through VBA and Acrobat IAC上的帖子功不可没。

我已经在下面修改了您的代码，以使用JavaScript对象包括他的代码：

内部修改：

'************************************************** *************** '***************************************************** ************

Dim acroExchangeApp As Object
    Set app = CreateObject("Acroexch.app")

    Dim filePaths As Collection     'Paths for PDFS to append
    Set filePaths = New Collection
    Dim fileRows As Collection      'Row numbers PDFs to append
    Set fileRows = New Collection
    Dim sourceDoc As Object
    Dim primaryDoc As Object        ' PrimaryDoc is what we append too
    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
    Dim colIndex As Long            '
    Dim numPages As Long
    Dim acroDoc As Object
    Set acroDoc = New AcroPDDoc


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

    For colIndex = 2 To filePaths.count
        query_start_time = time()
        start_memory = GetWorkingMemoryUsage

        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

        'inserts pages
        acroDoc.Open source_file_name

        insertPoint = acroDoc.GetNumPages - 1

        If endPage > 1 Then
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage & " PAGES INSERTED SUCCESSFULLY: " & OK
        Else
            OK = primaryDoc.InsertPages(insertPoint, sourceDoc, startPage, endPage - startPage + 1, False)
            Debug.Print "(" & colIndex & ") " & endPage - startPage + 1 & " PAGES INSERTED SUCCESSFULLY: " & OK
        End If

           Set sourceDoc = Nothing

    Next colIndex

    OK = primaryDoc.Save(PDSaveFull, filePaths(1))

        '*************************************************************
        '*************************************************************
        Dim jso As Object

        Set jso = primaryDoc.GetJSObject


        'Write page numbers to all pages
        For i = 1 To primaryDoc.GetNumPages
            jso.addWatermarkFromText _
                cText:=Str(i) & "  ", _
                nTextAlign:=1, _
                nHorizAlign:=2, _
                nVertAlign:=4, _
                nStart:=i - 1, _
                nEnd:=i - 1
        Next i
        '*************************************************************
        '*************************************************************

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

    Set primaryDoc = Nothing
    app.Exit
    Set app = Nothing

Answer 2

我尝试了AddField和水印。

AddField花费的时间少于2秒（对于13页的文档）对于同一文档，水印需要20秒钟以上的时间将中间部分更改为：

For i = 0 To intPages - 1
    Set objTextfeld = jso.AddField("Textfeld" & i, "text", i, Array(250, 50, 300, 0))
    objTextfeld.Value = "--" & Str(i + 1) & " --"
    objTextfeld.textSize = 10
    objTextfeld.textFont = "Calibri"
Next i

完整代码如下：

Sub addPageNumbers(sFile As String)
Dim AcroApp As Acrobat.CAcroApp
Dim jso As Object
Dim KurzGesamt As Acrobat.CAcroPDDoc
Dim i As Integer, intPages As Integer
Dim objTextfeld As Object

Set AcroApp = CreateObject("AcroExch.App")
Set KurzGesamt = CreateObject("AcroExch.PDDoc")
KurzGesamt.Open (sFile)
Set jso = KurzGesamt.GetJSObject
intPages = KurzGesamt.GetNumPages

For i = 0 To intPages - 1
    Set objTextfeld = jso.AddField("Textfeld" & i, "text", i, Array(250, 50, 300, 0))
    objTextfeld.Value = "--" & Str(i + 1) & " --"
    objTextfeld.textSize = 10
    objTextfeld.textFont = "Calibri"
Next i

jso.FlattenPages

Call KurzGesamt.Save(1, sFile)

Set jso = Nothing
Call AcroApp.CloseAllDocs
Set KurzGesamt = Nothing
Call AcroApp.Exit
Set AcroApp = Nothing
'Debug.Print "Done!"
End Sub

VBA，Acrobat Pro将页眉和页脚添加到Pdf中

2 个答案: