2016-12-23 11 views
0

こんにちはでPDFファイルをマージ以下のコードは、Adobe Acrobatのを使用してPDFをマージしたときにページ番号を追加します。それは動作しますが、ドキュメントにページ番号を追加して、4ページずつ2つのドキュメントをマージすると、ページ番号が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 

答えて

0

は、あなたのPDFにフッター、ページ番号を追加するスタンドアロンVBS/VBAスクリプトを添付しました。 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 

また、これは/あなたがどのように使用できるか/ VBS経由AcroJsを実行する実証しますVBAをJSO(Java Script Object)に変換せずに実行できます。

幸運、ラインハルト