Acrobat IAC練習 CropBoxのサイズをExcelシートに表示

メモ

CropBoxのサイズをExcelシートに表示して、印刷時の用紙選択ミス削減に役立てる。

使い捨てスクリプト

• PDFをタブに表示させた状態でマクロを実行してください

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

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

Option Explicit

Public Sub ShowActiveDocCropBoxSize()

#Const DebugVersion = False

#If DebugVersion Then
  Dim pdfAVApp As Acrobat.AcroApp
  Dim pdfAVDoc As Acrobat.AcroAVDoc
  Dim pdfPDDoc As Acrobat.AcroPDDoc
  Dim pdfPDPage As Acrobat.AcroPDPage
#Else
  Dim pdfAVApp As Object
  Dim pdfAVDoc As Object
  Dim pdfPDDoc As Object
  Dim pdfPDPage As Object
#End If

  Dim pdfJSObj As Object

  Dim pdfPageNum As Long, pdfNumPages As Long
  Dim pdfPageBox As Variant
  Dim pdfX1mm() As Double, pdfY1mm() As Double
  Dim pdfX2mm() As Double, pdfY2mm() As Double
  Dim pdfRot() As Long

#If DebugVersion Then
  Dim xlsApp As Excel.Application
  Dim xlsWs As Excel.Worksheet
#Else
  Dim xlsApp As Object
  Dim xlsWs As Object
#End If

  Dim xlsNumRow As Long
  Dim xlsRngValue As Variant

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

  Set pdfAVDoc = pdfAVApp.GetActiveDoc()

  If pdfAVDoc Is Nothing Then
    Set pdfAVApp = Nothing
    VBA.Information.Err.Raise Number:=65535, Description:="pdfAVDoc Is Nothing"
    Exit Sub
  End If

  pdfAVDoc.BringToFront

  Set pdfPDDoc = pdfAVDoc.GetPDDoc()

  Set pdfJSObj = pdfPDDoc.GetJSObject()
  pdfJSObj.console.Show
  pdfJSObj.console.println "// 実行方法はテキストを範囲選択して Ctrl + Enter"

  pdfNumPages = pdfPDDoc.GetNumPages()

  ReDim pdfX1mm(0 To pdfNumPages - 1), pdfY1mm(0 To pdfNumPages - 1)
  ReDim pdfX2mm(0 To pdfNumPages - 1), pdfY2mm(0 To pdfNumPages - 1)
  ReDim pdfRot(0 To pdfNumPages - 1)

  For pdfPageNum = 0 To pdfNumPages - 1 Step 1
    Set pdfPDPage = pdfPDDoc.AcquirePage(nPage:=pdfPageNum)
    pdfRot(pdfPageNum) = pdfPDPage.GetRotate()
    Set pdfPDPage = Nothing

    pdfPageBox = pdfJSObj.getPageBox("Crop", pdfPageNum)

    pdfX1mm(pdfPageNum) = 25.4 / 72 * pdfPageBox(0)
    pdfY1mm(pdfPageNum) = 25.4 / 72 * pdfPageBox(3)
    pdfX2mm(pdfPageNum) = 25.4 / 72 * pdfPageBox(2)
    pdfY2mm(pdfPageNum) = 25.4 / 72 * pdfPageBox(1)
  Next pdfPageNum

  Set xlsApp = VBA.Interaction.CreateObject(Class:="Excel.Application")
  xlsApp.Visible = True

  Set xlsWs = xlsApp.Workbooks.Add().Worksheets(1)

  ReDim xlsRngValue(1 To pdfNumPages + 1, 1 To 5)

  xlsRngValue(1, 1) = "ページ番号"
  xlsRngValue(1, 2) = "ヨコ[mm]"
  xlsRngValue(1, 3) = "タテ[mm]"
  xlsRngValue(1, 4) = "回転[度]"
  xlsRngValue(1, 5) = "ファイル名"

  For pdfPageNum = 0 To pdfNumPages - 1 Step 1
    xlsNumRow = pdfPageNum + 2
    xlsRngValue(xlsNumRow, 1) = pdfPageNum + 1
    xlsRngValue(xlsNumRow, 2) = pdfX2mm(pdfPageNum) - pdfX1mm(pdfPageNum)
    xlsRngValue(xlsNumRow, 3) = pdfY2mm(pdfPageNum) - pdfY1mm(pdfPageNum)
    xlsRngValue(xlsNumRow, 4) = pdfRot(pdfPageNum)
    xlsRngValue(xlsNumRow, 5) = pdfPDDoc.GetFileName()
  Next pdfPageNum

  xlsWs.Range( _
    xlsWs.Cells(1, 1), xlsWs.Cells(pdfNumPages + 1, 5) _
  ).Columns(5).NumberFormatLocal = "@"

  xlsWs.Range( _
    xlsWs.Cells(1, 1), xlsWs.Cells(pdfNumPages + 1, 5) _
  ) = xlsRngValue

  xlsWs.Columns.AutoFit

  Set xlsWs = Nothing
  Set xlsApp = Nothing

  Set pdfJSObj = Nothing
  Set pdfPDDoc = Nothing
  Set pdfAVDoc = Nothing
  Set pdfAVApp = Nothing

End Sub