以编程方式将PDF与acrobat合并时添加页码

时间:2016-12-23 16:30:48

标签: excel vba excel-vba pdf-generation acrobat

下面的代码使用adobe acrobat合并pdf。它的工作原理,但我希望在文档中添加页码,这样如果我合并2个文件,每页4页,页码从1到8.如何做到这一点?

以下是代码:

'http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X
Sub MergePDFs()
     ' ZVI:2013-08-27 http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X
     ' Reference required: "VBE - Tools - References - Acrobat"

     ' --> Settings, change to suit
    Const MyPath = "C:\mypath" '"C:\Temp" ' Path where PDF files are stored
    Const MyFiles = "file1.pdf,file2.pdf" ' List of PDFs to ne merged
    Const DestFile = "MergedFile.pdf" ' The name of the merged file
     ' <-- End of settings

    Dim a As Variant, i As Long, n As Long, ni As Long, p As String
    Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

    If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
    a = Split(MyFiles, ",")
    ReDim PartDocs(0 To UBound(a))

    On Error GoTo exit_
    If Len(Dir(p & DestFile)) Then Kill p & DestFile
    For i = 0 To UBound(a)
         ' Check PDF file presence
        If Dir(p & Trim(a(i))) = "" Then
            MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
            Exit For
        End If
         ' Open PDF document
        Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
        PartDocs(i).Open p & Trim(a(i))

        If i Then
             ' Merge PDF to PartDocs(0) document
            ni = PartDocs(i).GetNumPages()
            If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
                MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled"
            End If
             ' Calc the number of pages in the merged document
            n = n + ni
             ' Release the memory
            PartDocs(i).Close
            Set PartDocs(i) = Nothing
        Else
             ' Calc the number of pages in PartDocs(0) document
            n = PartDocs(0).GetNumPages()
        End If
    Next

    If i > UBound(a) Then
         ' Save the merged document to DestFile
        If Not PartDocs(0).Save(PDSaveFull, p & DestFile) Then
            MsgBox "Cannot save the resulting document" & vbLf & p & DestFile, vbExclamation, "Canceled"
        End If
    End If

exit_:

     ' Inform about error/success
    If Err Then
        MsgBox Err.Description, vbCritical, "Error #" & Err.Number
    ElseIf i > UBound(a) Then
        MsgBox "The resulting file is created:" & vbLf & p & DestFile, vbInformation, "Done"
    End If

     ' Release the memory
    If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
    Set PartDocs(0) = Nothing

     ' Quit Acrobat application
    AcroApp.Exit
    Set AcroApp = Nothing

End Sub

1 个答案:

答案 0 :(得分:0)

附加了一个独立的VBS / VBA脚本,它将页码作为页脚添加到您的pdf中。您可以在保存pdf之前取出所需的部件并写入脚本,然后再执行。

完整脚本:

File = "D:\Test.pdf"

Set App = CreateObject("Acroexch.app")      '//start acrobat
app.show                                    '//show Acrobat or comment out for hidden mode
Set AVDoc = CreateObject("AcroExch.AVDoc")
Set AForm = CreateObject("AFormAut.App")   '//get AFormAPI to execute js later

If AVDoc.Open(File,"") Then
    '//write JS-Code on a variable
    Ex = "  //  set Date, filename and PageNo as footer "&vbLF _
      & "  var Box2Width = 50  "&vbLF _
      & "  for (var p = 0; p < this.numPages; p++)   "&vbLF _
      & "   {   "&vbLF _
      & "    var aRect = this.getPageBox(""Crop"",p);  "&vbLF _
      & "    var TotWidth = aRect[2] - aRect[0]  "&vbLF _
      & "     {  var bStart=(TotWidth/2)-(Box2Width/2)  "&vbLF _
      & "         var bEnd=((TotWidth/2)+(Box2Width/2))  "&vbLF _
      & "         var fp = this.addField(String(""xftPage""+p+1), ""text"", p, [bStart,30,bEnd,15]);   "&vbLF _
      & "         fp.value = ""Page: "" + String(p+1)+ ""/"" + this.numPages;  "&vbLF _
      & "         fp.textSize=6;  fp.readonly = true;  "&vbLF _
      & "         fp.alignment=""center"";  "&vbLF _
      & "     }  "&vbLF _
      & "   }  "
    '//Execute JS-Code
       AForm.Fields.ExecuteThisJavaScript Ex
    msgBox("Done")
end if

Set AVDoc = Nothing
Set APP = Nothing

如果您只想接管脚本,那么您真正需要的部分:

Set AForm = CreateObject("AFormAut.App")  
Ex = "  //  set Date, filename and PageNo as footer "&vbLF _
  & " .....

  & " .....
  & "   }  "
'//Execute JS-Code
 AForm.Fields.ExecuteThisJavaScript Ex

这也演示了如何在不转换为JSO(Java脚本对象)的情况下通过VBS / VBA使用/执行AcroJs。

祝你好运,莱因哈德