Acrobat IAC練習 ページを差し込む

メモ

AcroPDDoc.InsertPagesの練習

使い捨てスクリプト

• 表示中のPDFファイル(pdfPDDocActive)のページ順序を 12345 とする
• 保存されている別のPDFファイル(pdfPDDocSource)のページ順序を ABCDE とする
• pdfPDDocActive に pdfPDDocSource を差し込んで 1A2B3C4D5E とする

' Excel 2019, Acrobat Standard DC (2022年3月頃), Windows 11

' 参照設定
' Acrobat (Adobe Acrobat 10.0 Type Library)

Option Explicit

Public Sub Main()

#Const DebugVersion = False

#If DebugVersion Then
  Dim pdfAVApp As Acrobat.AcroApp
  Dim pdfAVDocActive As Acrobat.AcroAVDoc
  Dim pdfPDDocActive As Acrobat.AcroPDDoc
  Dim pdfPDDocSource As Acrobat.AcroPDDoc
#Else
  Dim pdfAVApp As Object
  Dim pdfAVDocActive As Object
  Dim pdfPDDocActive As Object
  Dim pdfPDDocSource As Object
#End If

  Dim pdfPageNum As Long, pdfNumPages As Long

  On Error GoTo ErrorHandler

  Set pdfAVApp = VBA.Interaction.CreateObject(Class:="AcroExch.App")
  Set pdfAVDocActive = pdfAVApp.GetActiveDoc()

  ' PDFファイルがタブに表示されている状態としてください
  If pdfAVDocActive Is Nothing Then
    VBA.Information.Err.Raise _
      Number:=65535, Description:="pdfAVDocActive: Nothing"
  End If

  Set pdfPDDocActive = pdfAVDocActive.GetPDDoc()

  Set pdfPDDocSource = VBA.Interaction.CreateObject(Class:="AcroExch.pdDoc")

  ' デスクトップのアイコン右クリック「パスのコピー」で取得したパスを貼り付ける
  If Not pdfPDDocSource.Open(VBA.Strings.Split(VBA.Interaction.InputBox( _
    Prompt:="PDFファイル", Default:="""C:\tmp\source.pdf"""), """")(1)) Then

    VBA.Information.Err.Raise _
      Number:=65535, Description:="pdfPDDocSource.Open: False"
  End If

  pdfNumPages = pdfPDDocActive.GetNumPages()

  For pdfPageNum = 0 To pdfNumPages - 1 Step 1
    If pdfPageNum Mod 20 = 0 Then
      VBA.Interaction.DoEvents
    End If

    If Not pdfPDDocActive.InsertPages( _
      nInsertPageAfter:=pdfPageNum * 2, _
      iPDDocSource:=pdfPDDocSource, lStartPage:=pdfPageNum, lNumPages:=1, _
      lInsertFlags:=0) Then

      VBA.Information.Err.Raise _
        Number:=65535, Description:="pdfPDDocActive.InsertPages: False"
    End If

  Next pdfPageNum

  pdfAVDocActive.BringToFront

  Set pdfPDDocSource = Nothing
  Set pdfPDDocActive = Nothing
  Set pdfAVDocActive = Nothing
  Set pdfAVApp = Nothing

  Exit Sub

ErrorHandler:
  Set pdfPDDocSource = Nothing
  Set pdfPDDocActive = Nothing
  Set pdfAVDocActive = Nothing
  Set pdfAVApp = Nothing
  VBA.Information.Err.Raise Number:=VBA.Information.Err.Number

End Sub