VBAでPDF座標を取得する方法｜文書解析と自動化の完全ガイド

「VBAでPDFファイルから特定の位置の座標を取得したい…」「PDF内のテキストや図形の座標情報を自動で抽出できないかな？」

こんな課題に直面していませんか？業務でPDFファイルの情報を自動処理したり、特定の位置のデータを抽出したりする需要は年々高まっています。

この記事では、VBA（Visual Basic for Applications）を使ってPDFファイルから座標情報を取得する方法を、初心者にも分かりやすく解説します。基本的な仕組みから実用的なコード例まで、段階的に学んでいきましょう。

PDF座標取得の基本概念
Adobe Acrobat連携による座標取得
PDF-XChange連携での座標取得
無料ライブラリでの座標取得
テキストの座標情報抽出
図形・画像の座標情報取得
実用的な応用例とコードサンプル
まとめ

PDF座標取得の基本概念

PDFファイルで座標を扱う前に、基本的な仕組みを理解することが重要です。

PDFの座標系について

PDFでは独特の座標系が使用されています：

原点の位置

左下角が原点（0,0）
X軸は右方向が正
Y軸は上方向が正

単位の考え方

基本単位はポイント（pt）
1インチ = 72ポイント
1ミリメートル ≈ 2.83ポイント

ページサイズとの関係

A4サイズ：595 × 842ポイント
Letter サイズ：612 × 792ポイント
座標はページサイズ内で計算

VBAで扱える座標情報の種類

VBAを通じて取得可能な座標データには以下があります：

テキストオブジェクトの座標

文字列の開始位置
テキストボックスの境界
フォントサイズと行間情報

図形オブジェクトの座標

線分の開始点と終了点
矩形の四隅座標
円形の中心点と半径

注釈・フォームフィールドの座標

コメントの配置位置
入力フィールドの境界
ボタンやチェックボックスの位置

これらの座標情報を活用することで、PDF内容の詳細な解析が可能になります。

座標取得の主な用途

実際のビジネスシーンでの活用例：

請求書の金額欄座標を特定して自動読み取り
図面内の寸法線座標を抽出してデータベース化
フォーム入力欄の位置情報を取得して自動入力
印章・署名の位置確認と検証

これらの応用により、業務効率の大幅な向上が期待できます。

Adobe Acrobat連携による座標取得

最も確実で高機能な方法として、Adobe Acrobatとの連携があります。

必要な環境設定

VBAからAdobe Acrobatを操作するための準備：

Adobe Acrobat Proのインストール
- Standard版では一部機能に制限
- Pro版推奨（DC版も対応）
VBA参照設定の追加 ' VBAエディタで「ツール」→「参照設定」 ' 「Acrobat」または「Adobe Acrobat XX.0 Type Library」をチェック
セキュリティ設定の確認
- マクロセキュリティの適切な設定
- Acrobatのセキュリティポリシー確認

基本的な座標取得コード

シンプルなテキスト座標取得の例：

Sub GetPDFCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    ' Adobe Acrobatを起動
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    ' PDFファイルを開く
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' JavaScript経由で座標取得
        Dim result As String
        result = JSO.getPageBox("Media", 0) ' ページボックス取得
        
        Debug.Print "ページサイズ: " & result
        
        ' クリーンアップ
        AcroDoc.Close True
        AcroApp.Exit
    End If
    
    Set JSO = Nothing
    Set PDDoc = Nothing
    Set AcroDoc = Nothing
    Set AcroApp = Nothing
End Sub

JavaScript連携での高度な座標取得

Acrobat JavaScriptを活用したより詳細な座標取得：

Sub GetTextCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' JavaScript関数を実行
        Dim jsCode As String
        jsCode = "var words = this.getPageNthWord(0, 0, true);" & _
                "var quads = this.getPageNthWordQuads(0, 0);" & _
                "app.alert('Word: ' + words + ', Coordinates: ' + quads);"
        
        JSO.ExecJS jsCode
        
        ' クリーンアップ処理
        AcroDoc.Close True
        AcroApp.Exit
    End If
End Sub

エラーハンドリングと最適化

安定した処理のための改良版：

Sub GetPDFCoordinatesWithErrorHandling()
    On Error GoTo ErrorHandler
    
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    ' オブジェクト初期化
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    ' ファイル存在確認
    Dim filePath As String
    filePath = "C:\sample.pdf"
    
    If Dir(filePath) = "" Then
        MsgBox "ファイルが見つかりません: " & filePath
        Exit Sub
    End If
    
    ' PDF処理
    If AcroDoc.Open(filePath, "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        
        ' ページ数確認
        Dim pageCount As Integer
        pageCount = PDDoc.GetNumPages()
        Debug.Print "総ページ数: " & pageCount
        
        ' 各ページの座標情報取得
        Dim i As Integer
        For i = 0 To pageCount - 1
            Call GetPageCoordinates(PDDoc, i)
        Next i
        
        AcroDoc.Close True
    Else
        MsgBox "PDFファイルを開けませんでした"
    End If
    
    GoTo CleanUp
    
ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description
    
CleanUp:
    ' メモリ解放
    If Not AcroDoc Is Nothing Then AcroDoc.Close True
    If Not AcroApp Is Nothing Then AcroApp.Exit
    
    Set JSO = Nothing
    Set PDDoc = Nothing
    Set AcroDoc = Nothing
    Set AcroApp = Nothing
End Sub

Private Sub GetPageCoordinates(PDDoc As Acrobat.AcroPDDoc, pageNum As Integer)
    Dim JSO As Object
    Set JSO = PDDoc.GetJSObject()
    
    ' ページボックス情報取得
    Dim pageBox As String
    pageBox = JSO.getPageBox("Media", pageNum)
    
    Debug.Print "ページ " & (pageNum + 1) & " サイズ: " & pageBox
End Sub

このコードにより、安定した座標取得処理が実現できます。

PDF-XChange連携での座標取得

コストパフォーマンスに優れたPDF-XChangeを使用した方法です。

PDF-XChange Editorとの連携

Adobe Acrobatの代替として人気の高いソフトウェアです：

主な特徴

高速な処理速度
豊富なAPI機能
比較的安価な導入コスト

VBA連携の準備

PDF-XChange Editor Proのインストール
参照設定で「PDFXEdit」ライブラリを追加
ライセンス認証の確認

基本的な連携コード

Sub GetCoordinatesWithPDFXChange()
    Dim pdfApp As Object
    Dim pdfDoc As Object
    
    ' PDF-XChangeアプリケーション起動
    Set pdfApp = CreateObject("PDFXEdit.Application")
    
    ' PDFファイルを開く
    Set pdfDoc = pdfApp.OpenDocumentFromFile("C:\sample.pdf", "", 0)
    
    If Not pdfDoc Is Nothing Then
        ' ページ情報取得
        Dim pageCount As Integer
        pageCount = pdfDoc.GetPagesCount()
        
        Debug.Print "ページ数: " & pageCount
        
        ' 最初のページの情報取得
        Dim page As Object
        Set page = pdfDoc.GetPage(0)
        
        ' ページサイズ取得
        Dim pageWidth As Double, pageHeight As Double
        pageWidth = page.GetWidth()
        pageHeight = page.GetHeight()
        
        Debug.Print "ページサイズ: " & pageWidth & " x " & pageHeight
        
        ' 文書を閉じる
        pdfDoc.Close(0)
    End If
    
    ' アプリケーション終了
    pdfApp.Quit()
    
    Set page = Nothing
    Set pdfDoc = Nothing
    Set pdfApp = Nothing
End Sub

テキスト検索と座標取得

特定のテキストの位置を見つける方法：

Sub FindTextCoordinates()
    Dim pdfApp As Object
    Dim pdfDoc As Object
    
    Set pdfApp = CreateObject("PDFXEdit.Application")
    Set pdfDoc = pdfApp.OpenDocumentFromFile("C:\sample.pdf", "", 0)
    
    If Not pdfDoc Is Nothing Then
        Dim page As Object
        Set page = pdfDoc.GetPage(0)
        
        ' テキスト検索パラメータ設定
        Dim searchText As String
        searchText = "合計金額"
        
        ' 検索実行（簡易版）
        ' 実際のAPIではより詳細な検索機能が利用可能
        Debug.Print "テキスト '" & searchText & "' を検索中..."
        
        ' クリーンアップ
        pdfDoc.Close(0)
    End If
    
    pdfApp.Quit()
End Sub

注釈情報の座標取得

PDF内の注釈（コメント、ハイライトなど）の座標を取得：

Sub GetAnnotationCoordinates()
    Dim pdfApp As Object
    Dim pdfDoc As Object
    
    Set pdfApp = CreateObject("PDFXEdit.Application")
    Set pdfDoc = pdfApp.OpenDocumentFromFile("C:\sample.pdf", "", 0)
    
    If Not pdfDoc Is Nothing Then
        Dim page As Object
        Set page = pdfDoc.GetPage(0)
        
        ' 注釈数を取得
        Dim annotCount As Integer
        annotCount = page.GetAnnotsCount()
        
        Debug.Print "注釈数: " & annotCount
        
        ' 各注釈の情報を取得
        Dim i As Integer
        For i = 0 To annotCount - 1
            Dim annot As Object
            Set annot = page.GetAnnot(i)
            
            ' 注釈の境界座標取得
            ' （具体的なプロパティ名はAPIドキュメント参照）
            Debug.Print "注釈 " & (i + 1) & " の情報取得完了"
            
            Set annot = Nothing
        Next i
        
        pdfDoc.Close(0)
    End If
    
    pdfApp.Quit()
End Sub

これらの方法により、様々な座標情報の取得が可能になります。

無料ライブラリでの座標取得

コストを抑えて座標取得を実現したい場合の方法です。

iTextSharp（.NET）との連携

無料で高機能なPDFライブラリの活用：

VBA + .NET Framework連携

Sub UseiTextSharpWithCOM()
    ' COMラッパー経由でiTextSharpを使用
    ' 事前に.NETアセンブリのCOM登録が必要
    
    Dim comHelper As Object
    Set comHelper = CreateObject("PDFHelper.COMWrapper")
    
    ' PDFファイルのテキスト座標取得
    Dim coordinates As String
    coordinates = comHelper.GetTextCoordinates("C:\sample.pdf", "検索文字列")
    
    Debug.Print "座標情報: " & coordinates
    
    Set comHelper = Nothing
End Sub

PDFtk（コマンドライン）との連携

軽量で高速なPDFツールキット：

Sub UsePDFtkForInfo()
    Dim shellCmd As String
    Dim result As String
    
    ' PDFtkでメタデータ取得
    shellCmd = "pdftk C:\sample.pdf dump_data output C:\temp\info.txt"
    
    ' コマンド実行
    Shell shellCmd, vbHide
    
    ' 結果ファイル読み込み
    Application.Wait Now + TimeValue("00:00:02") ' 2秒待機
    
    If Dir("C:\temp\info.txt") <> "" Then
        Dim fileNum As Integer
        fileNum = FreeFile
        
        Open "C:\temp\info.txt" For Input As fileNum
        
        Do Until EOF(fileNum)
            Line Input #fileNum, result
            If InStr(result, "PageMediaBegin") > 0 Then
                Debug.Print "ページ情報: " & result
            End If
        Loop
        
        Close fileNum
        Kill "C:\temp\info.txt" ' 一時ファイル削除
    End If
End Sub

Poppler Utils連携

オープンソースのPDF処理ツール群：

Sub UsePopplerUtils()
    Dim shellCmd As String
    Dim outputFile As String
    
    outputFile = "C:\temp\pdf_info.txt"
    
    ' pdfinfo.exeでPDF情報取得
    shellCmd = "pdfinfo -meta C:\sample.pdf > " & outputFile
    
    Shell "cmd /c " & shellCmd, vbHide
    
    ' 結果解析
    Application.Wait Now + TimeValue("00:00:01")
    
    If Dir(outputFile) <> "" Then
        Call ParsePDFInfo(outputFile)
        Kill outputFile
    End If
End Sub

Private Sub ParsePDFInfo(filePath As String)
    Dim fileNum As Integer
    Dim line As String
    
    fileNum = FreeFile
    Open filePath For Input As fileNum
    
    Do Until EOF(fileNum)
        Line Input #fileNum, line
        
        If InStr(line, "Page size:") > 0 Then
            Debug.Print "ページサイズ: " & line
        ElseIf InStr(line, "Pages:") > 0 Then
            Debug.Print "ページ数: " & line
        End If
    Loop
    
    Close fileNum
End Sub

Python スクリプトとの連携

PyPDF2やPyMuPDFライブラリを活用：

Sub CallPythonScript()
    Dim pythonScript As String
    Dim shellCmd As String
    
    ' Pythonスクリプトのパス
    pythonScript = "C:\scripts\pdf_coordinates.py"
    
    ' Pythonスクリプト実行
    shellCmd = "python " & pythonScript & " C:\sample.pdf"
    
    Shell "cmd /c " & shellCmd & " > C:\temp\coordinates.txt", vbHide
    
    ' 結果読み込み
    Application.Wait Now + TimeValue("00:00:03")
    Call ReadPythonOutput("C:\temp\coordinates.txt")
End Sub

Private Sub ReadPythonOutput(filePath As String)
    If Dir(filePath) <> "" Then
        Dim fileNum As Integer
        Dim result As String
        
        fileNum = FreeFile
        Open filePath For Input As fileNum
        
        Do Until EOF(fileNum)
            Line Input #fileNum, result
            Debug.Print "Python出力: " & result
        Loop
        
        Close fileNum
        Kill filePath
    End If
End Sub

これらの無料ソリューションにより、コストを抑えた座標取得が実現できます。

テキストの座標情報抽出

PDF内の特定テキストの正確な位置情報を取得する方法です。

文字単位での座標取得

個々の文字の詳細な位置情報：

Sub GetCharacterCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 最初のページの最初の文字の座標を取得
        Dim jsCode As String
        jsCode = "var char = this.getPageNthWord(0, 0);" & _
                "var quad = this.getPageNthWordQuads(0, 0);" & _
                "var result = 'Character: ' + char + ', X: ' + quad[0][0] + ', Y: ' + quad[0][1];" & _
                "result;"
        
        Dim result As String
        result = JSO.ExecJS(jsCode)
        
        Debug.Print "文字座標: " & result
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

単語レベルでの座標取得

単語単位での位置情報と境界ボックス：

Sub GetWordCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' ページ内の全単語をスキャン
        Dim pageNum As Integer
        pageNum = 0
        
        Dim wordCount As Integer
        wordCount = JSO.getPageNumWords(pageNum)
        
        Debug.Print "ページ " & (pageNum + 1) & " の単語数: " & wordCount
        
        ' 各単語の座標取得
        Dim i As Integer
        For i = 0 To wordCount - 1
            Dim word As String
            Dim quads As Variant
            
            word = JSO.getPageNthWord(pageNum, i)
            ' quads = JSO.getPageNthWordQuads(pageNum, i)
            
            ' 結果出力（実際の座標取得はJavaScript関数で実装）
            Debug.Print "単語 " & (i + 1) & ": " & word
        Next i
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

特定文字列の検索と座標取得

指定した文字列の位置を特定：

Sub FindStringCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 検索対象文字列
        Dim searchText As String
        searchText = "合計金額"
        
        ' JavaScript経由で検索実行
        Dim jsCode As String
        jsCode = "var pageNum = 0;" & _
                "var numWords = this.getPageNumWords(pageNum);" & _
                "var found = false;" & _
                "var coordinates = '';" & _
                "for(var i = 0; i < numWords; i++) {" & _
                "  var word = this.getPageNthWord(pageNum, i);" & _
                "  if(word.indexOf('" & searchText & "') >= 0) {" & _
                "    var quads = this.getPageNthWordQuads(pageNum, i);" & _
                "    coordinates = 'Found at: X=' + quads[0][0] + ', Y=' + quads[0][1];" & _
                "    found = true;" & _
                "    break;" & _
                "  }" & _
                "}" & _
                "coordinates;"
        
        Dim result As String
        result = JSO.ExecJS(jsCode)
        
        If result <> "" Then
            Debug.Print "検索結果: " & result
        Else
            Debug.Print "文字列 '" & searchText & "' が見つかりませんでした"
        End If
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

正規表現を使った高度な検索

パターンマッチングによる柔軟な文字列検索：

Sub FindPatternCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 正規表現パターン（例：数字と円マーク）
        Dim pattern As String
        pattern = "\d+円"
        
        Dim jsCode As String
        jsCode = "var pageNum = 0;" & _
                "var numWords = this.getPageNumWords(pageNum);" & _
                "var pattern = /" & pattern & "/;" & _
                "var results = [];" & _
                "for(var i = 0; i < numWords; i++) {" & _
                "  var word = this.getPageNthWord(pageNum, i);" & _
                "  if(pattern.test(word)) {" & _
                "    var quads = this.getPageNthWordQuads(pageNum, i);" & _
                "    results.push('Word: ' + word + ', X: ' + quads[0][0] + ', Y: ' + quads[0][1]);" & _
                "  }" & _
                "}" & _
                "results.join('; ');"
        
        Dim results As String
        results = JSO.ExecJS(jsCode)
        
        If results <> "" Then
            Debug.Print "パターンマッチ結果: " & results
        Else
            Debug.Print "パターンに一致する文字列が見つかりませんでした"
        End If
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

これらの方法により、テキストの詳細な位置情報を効率的に取得できます。

図形・画像の座標情報取得

PDF内の図形や画像オブジェクトの座標を取得する方法です。

画像オブジェクトの座標取得

埋め込まれた画像の位置とサイズ情報：

Sub GetImageCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' JavaScript経由で画像情報取得
        Dim jsCode As String
        jsCode = "var pageNum = 0;" & _
                "var page = this.getPageBox('Media', pageNum);" & _
                "var annotations = this.getAnnots(pageNum);" & _
                "var imageCount = 0;" & _
                "if(annotations) {" & _
                "  for(var i = 0; i < annotations.length; i++) {" & _
                "    if(annotations[i].type == 'Stamp' || annotations[i].type == 'Image') {" & _
                "      imageCount++;" & _
                "      var rect = annotations[i].rect;" & _
                "      app.alert('Image ' + imageCount + ': X=' + rect[0] + ', Y=' + rect[1] + ', W=' + (rect[2]-rect[0]) + ', H=' + (rect[3]-rect[1]));" & _
                "    }" & _
                "  }" & _
                "}" & _
                "imageCount;"
        
        Dim imageCount As Integer
        imageCount = JSO.ExecJS(jsCode)
        
        Debug.Print "画像オブジェクト数: " & imageCount
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

線分・矢印の座標取得

描画された線分や矢印の開始点・終了点：

Sub GetLineCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 線分注釈の座標取得
        Dim jsCode As String
        jsCode = "var pageNum = 0;" & _
                "var annotations = this.getAnnots(pageNum);" & _
                "var lineCount = 0;" & _
                "if(annotations) {" & _
                "  for(var i = 0; i < annotations.length; i++) {" & _
                "    if(annotations[i].type == 'Line') {" & _
                "      lineCount++;" & _
                "      var vertices = annotations[i].vertices;" & _
                "      if(vertices && vertices.length >= 4) {" & _
                "        app.alert('Line ' + lineCount + ': Start(' + vertices[0] + ',' + vertices[1] + ') End(' + vertices[2] + ',' + vertices[3] + ')');" & _
                "      }" & _
                "    }" & _
                "  }" & _
                "}" & _
                "lineCount;"
        
        Dim lineCount As Integer
        lineCount = JSO.ExecJS(jsCode)
        
        Debug.Print "線分オブジェクト数: " & lineCount
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

矩形・円形の座標取得

幾何学図形の境界座標：

Sub GetShapeCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\sample.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 図形注釈の座標取得
        Dim jsCode As String
        jsCode = "var pageNum = 0;" & _
                "var annotations = this.getAnnots(pageNum);" & _
                "var shapeInfo = [];" & _
                "if(annotations) {" & _
                "  for(var i = 0; i < annotations.length; i++) {" & _
                "    var ann = annotations[i];" & _
                "    if(ann.type == 'Square' || ann.type == 'Circle') {" & _
                "      var rect = ann.rect;" & _
                "      shapeInfo.push(ann.type + ': X=' + rect[0] + ', Y=' + rect[1] + ', W=' + (rect[2]-rect[0]) + ', H=' + (rect[3]-rect[1]));" & _
                "    }" & _
                "  }" & _
                "}" & _
                "shapeInfo.join('; ');"
        
        Dim shapeInfo As String
        shapeInfo = JSO.ExecJS(jsCode)
        
        If shapeInfo <> "" Then
            Debug.Print "図形情報: " & shapeInfo
        Else
            Debug.Print "図形オブジェクトが見つかりませんでした"
        End If
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

CAD図面での寸法線座標取得

技術図面でよく使用される寸法線の情報：

Sub GetDimensionCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\technical_drawing.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 寸法線パターンの検索
        Dim jsCode As String
        jsCode = "var pageNum = 0;" & _
                "var numWords = this.getPageNumWords(pageNum);" & _
                "var dimensions = [];" & _
                "for(var i = 0; i < numWords; i++) {" & _
                "  var word = this.getPageNthWord(pageNum, i);" & _
                "  if(/\d+\.?\d*\s*(mm|cm|m|inch|in|\")/.test(word)) {" & _
                "    var quads = this.getPageNthWordQuads(pageNum, i);" & _
                "    dimensions.push('Dimension: ' + word + ' at X=' + quads[0][0] + ', Y=' + quads[0][1]);" & _
                "  }" & _
                "}" & _
                "dimensions.join('; ');"
        
        Dim dimensionInfo As String
        dimensionInfo = JSO.ExecJS(jsCode)
        
        If dimensionInfo <> "" Then
            Debug.Print "寸法情報: " & dimensionInfo
        Else
            Debug.Print "寸法線が見つかりませんでした"
        End If
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

これらの方法により、様々な図形要素の詳細な座標情報を取得することができます。

実用的な応用例とコードサンプル

実際のビジネスシーンで活用できる具体的な応用例をご紹介します。

請求書の自動データ抽出

請求書PDFから金額や日付を自動抽出：

Sub ExtractInvoiceData()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    ' 抽出データ保存用
    Dim invoiceData As Collection
    Set invoiceData = New Collection
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\invoice.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 金額パターンの検索
        Call ExtractAmountData(JSO, invoiceData)
        
        ' 日付パターンの検索
        Call ExtractDateData(JSO, invoiceData)
        
        ' 会社名の検索
        Call ExtractCompanyData(JSO, invoiceData)
        
        ' 結果をExcelに出力
        Call OutputToExcel(invoiceData)
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

Private Sub ExtractAmountData(JSO As Object, dataCollection As Collection)
    Dim jsCode As String
    jsCode = "var pageNum = 0;" & _
            "var numWords = this.getPageNumWords(pageNum);" & _
            "var amounts = [];" & _
            "for(var i = 0; i < numWords; i++) {" & _
            "  var word = this.getPageNthWord(pageNum, i);" & _
            "  if(/[￥¥]\s*[\d,]+|[\d,]+\s*円/.test(word)) {" & _
            "    var quads = this.getPageNthWordQuads(pageNum, i);" & _
            "    amounts.push({text: word, x: quads[0][0], y: quads[0][1]});" & _
            "  }" & _
            "}" & _
            "JSON.stringify(amounts);"
    
    Dim result As String
    result = JSO.ExecJS(jsCode)
    
    ' JSON解析（簡易版）
    Debug.Print "金額データ: " & result
    dataCollection.Add result, "amounts"
End Sub

Private Sub ExtractDateData(JSO As Object, dataCollection As Collection)
    Dim jsCode As String
    jsCode = "var pageNum = 0;" & _
            "var numWords = this.getPageNumWords(pageNum);" & _
            "var dates = [];" & _
            "for(var i = 0; i < numWords; i++) {" & _
            "  var word = this.getPageNthWord(pageNum, i);" & _
            "  if(/\d{4}[\/\-年]\d{1,2}[\/\-月]\d{1,2}[日]?/.test(word)) {" & _
            "    var quads = this.getPageNthWordQuads(pageNum, i);" & _
            "    dates.push({text: word, x: quads[0][0], y: quads[0][1]});" & _
            "  }" & _
            "}" & _
            "JSON.stringify(dates);"
    
    Dim result As String
    result = JSO.ExecJS(jsCode)
    
    Debug.Print "日付データ: " & result
    dataCollection.Add result, "dates"
End Sub

Private Sub ExtractCompanyData(JSO As Object, dataCollection As Collection)
    ' 会社名パターンの検索（上部エリアに注目）
    Dim jsCode As String
    jsCode = "var pageNum = 0;" & _
            "var numWords = this.getPageNumWords(pageNum);" & _
            "var pageBox = this.getPageBox('Media', pageNum);" & _
            "var pageHeight = pageBox[3];" & _
            "var companies = [];" & _
            "for(var i = 0; i < numWords; i++) {" & _
            "  var word = this.getPageNthWord(pageNum, i);" & _
            "  var quads = this.getPageNthWordQuads(pageNum, i);" & _
            "  if(quads[0][1] > pageHeight * 0.8 && /(株式会社|有限会社|合同会社|\w+会社)/.test(word)) {" & _
            "    companies.push({text: word, x: quads[0][0], y: quads[0][1]});" & _
            "  }" & _
            "}" & _
            "JSON.stringify(companies);"
    
    Dim result As String
    result = JSO.ExecJS(jsCode)
    
    Debug.Print "会社名データ: " & result
    dataCollection.Add result, "companies"
End Sub

Private Sub OutputToExcel(dataCollection As Collection)
    ' Excelワークシートに結果を出力
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("請求書データ")
    
    Dim row As Integer
    row = 2 ' ヘッダー行の次から開始
    
    ws.Cells(row, 1).Value = "抽出完了"
    ws.Cells(row, 2).Value = Now()
    
    ' 詳細データの出力処理
    ' （実装は用途に応じてカスタマイズ）
End Sub

図面の寸法自動読み取り

CAD図面から寸法値を自動抽出してデータベース化：

Sub ExtractDrawingDimensions()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\drawing.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' 寸法値の抽出
        Dim dimensionData As String
        dimensionData = ExtractDimensions(JSO)
        
        ' 図面タイトルの抽出
        Dim titleData As String
        titleData = ExtractDrawingTitle(JSO)
        
        ' 結果をデータベースに保存
        Call SaveToDatabase(titleData, dimensionData)
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

Private Function ExtractDimensions(JSO As Object) As String
    Dim jsCode As String
    jsCode = "var pageNum = 0;" & _
            "var numWords = this.getPageNumWords(pageNum);" & _
            "var dimensions = [];" & _
            "for(var i = 0; i < numWords; i++) {" & _
            "  var word = this.getPageNthWord(pageNum, i);" & _
            "  if(/^\d+\.?\d*$/.test(word) && parseInt(word) > 0) {" & _
            "    var quads = this.getPageNthWordQuads(pageNum, i);" & _
            "    dimensions.push({" & _
            "      value: parseFloat(word)," & _
            "      x: Math.round(quads[0][0])," & _
            "      y: Math.round(quads[0][1])," & _
            "      text: word" & _
            "    });" & _
            "  }" & _
            "}" & _
            "JSON.stringify(dimensions);"
    
    ExtractDimensions = JSO.ExecJS(jsCode)
End Function

Private Function ExtractDrawingTitle(JSO As Object) As String
    Dim jsCode As String
    jsCode = "var pageNum = 0;" & _
            "var numWords = this.getPageNumWords(pageNum);" & _
            "var pageBox = this.getPageBox('Media', pageNum);" & _
            "var pageHeight = pageBox[3];" & _
            "var titles = [];" & _
            "for(var i = 0; i < numWords; i++) {" & _
            "  var word = this.getPageNthWord(pageNum, i);" & _
            "  var quads = this.getPageNthWordQuads(pageNum, i);" & _
            "  if(quads[0][1] < pageHeight * 0.2 && word.length > 3) {" & _
            "    titles.push(word);" & _
            "  }" & _
            "}" & _
            "titles.join(' ');"
    
    ExtractDrawingTitle = JSO.ExecJS(jsCode)
End Function

Private Sub SaveToDatabase(title As String, dimensions As String)
    ' データベース保存処理（ADOやDAO使用）
    Debug.Print "図面タイトル: " & title
    Debug.Print "寸法データ: " & dimensions
    
    ' 実際のデータベース処理をここに実装
End Sub

フォーム座標の一括取得

PDF帳票の入力フィールド座標を一括取得：

Sub GetFormFieldCoordinates()
    Dim AcroApp As Acrobat.AcroApp
    Dim AcroDoc As Acrobat.AcroAVDoc
    Dim PDDoc As Acrobat.AcroPDDoc
    Dim JSO As Object
    
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroDoc = CreateObject("AcroExch.AVDoc")
    
    If AcroDoc.Open("C:\form.pdf", "") Then
        Set PDDoc = AcroDoc.GetPDDoc()
        Set JSO = PDDoc.GetJSObject()
        
        ' フォームフィールドの座標情報取得
        Dim jsCode As String
        jsCode = "var fields = [];" & _
                "for(var i = 0; i < this.numFields; i++) {" & _
                "  var fieldName = this.getNthFieldName(i);" & _
                "  var field = this.getField(fieldName);" & _
                "  if(field && field.rect) {" & _
                "    fields.push({" & _
                "      name: fieldName," & _
                "      type: field.type," & _
                "      x: field.rect[0]," & _
                "      y: field.rect[1]," & _
                "      width: field.rect[2] - field.rect[0]," & _
                "      height: field.rect[3] - field.rect[1]" & _
                "    });" & _
                "  }" & _
                "}" & _
                "JSON.stringify(fields);"
        
        Dim fieldData As String
        fieldData = JSO.ExecJS(jsCode)
        
        Debug.Print "フォームフィールド情報: " & fieldData
        
        ' Excelに出力
        Call OutputFieldsToExcel(fieldData)
        
        AcroDoc.Close True
    End If
    
    AcroApp.Exit
End Sub

Private Sub OutputFieldsToExcel(jsonData As String)
    ' JSON解析とExcel出力
    ' （実装は用途に応じてカスタマイズ）
    Debug.Print "フィールド座標データをExcelに出力しました"
End Sub

これらの実用例により、様々な業務でPDF座標取得を活用できます。

まとめ

VBAを使ったPDF座標取得は、業務自動化において非常に強力なツールです。

今回ご紹介した内容をまとめると：

Adobe Acrobatとの連携で最も確実な座標取得が可能
PDF-XChangeなどの代替ソフトでもコストを抑えた実装ができる
無料ライブラリやツールを組み合わせた解決策もある
テキスト・図形・画像それぞれに適した取得方法がある
請求書処理や図面解析など実用的な応用が豊富

まずは簡単なテキスト座標取得から始めて、徐々に高度な機能を習得していくことをおすすめします。

PDF座標取得技術を習得することで、手作業では困難な大量文書の処理や、高精度なデータ抽出が可能になります。あなたの業務に最適な方法を選択して、効率的な文書処理システムを構築していきましょう。