Excel VBA、Acrobat Pro添加标题和；页脚到Pdf 我使用AcROAT席Pro与VBA结合我的PDF文件。

我有一个使用acrobat api将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

---

有人能帮上忙吗？

完全归功于@NiH在SO上发表的文章

我已经修改了下面的代码，以包括他使用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

---

我试过AddField和watermark

---

AddField回答了什么问题？@HackSlash抱歉，你能帮我自动在每个pdf中插入页脚吗？通过快速在线研究，Acrobat的API中似乎没有一种方法可以做到这一点。但是，如果您想知道这是否有帮助，似乎确实存在一个问题。@K.Dᴀᴠ谢谢你，我会调查的。嗨，你能解释一下

*

？你是说这是我需要添加到代码中的部分吗？是的，'*******中的所有内容。虽然你应该能够用我上面的代码替换你的代码…嘿，谢谢你，但是出于某种原因，它只对前3页进行编号。你知道为什么会这样吗？同时运行这个新添加的代码，我的pdf文件大小从10k KB变为20k KB，有3个页码！我尝试用

getnumpages

替换

NumpageToInsert

，但我的pdf文件超过300KB，最后仍然缺少2页。我修改了原始答案，并将“页码插入”代码移到原始“保存”命令的下方（并在移动代码后重复保存命令）. 这将允许访问新的、增加的页面计数。关于文件大小的增加，您遇到了一个常见问题。字体正在嵌入，这导致了增加。您还使用了PDSaveFull。有一个名为AVDocSaveOptimized的函数。我将看看如何利用它。

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