Office関連

Acrobat XIを操作してテキスト認識操作を行うVBAマクロ

マクロからAcrobatを操作する場合「PDFファイル上のフィールドの値を操作するVBAマクロ」のように、Acrobat JavaScriptを経由することで、様々な処理を実行できます。

しかし、テキスト認識(OCR)処理はJavaScriptで実行できないようだったので、UI Automationで無理やり画面操作をしてみました。

'UIAutomationClient(UIAutomationCore.dll)要参照
Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
  ByVal hWndParent As Long, _
  ByVal hWndChildAfter As Long, _
  ByVal lpszClass As String, _
  ByVal lpszWindow As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
  ByVal hWnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Public Sub Sample()
'Acrobat XIを操作してテキスト認識操作を行うマクロ
'※ 他のバージョンのAcrobatでは実行不可
  Dim appAcrobat As Object
  Dim avdoc As Object
  Dim uiAuto As CUIAutomation
  Dim elmAcrobat As IUIAutomationElement
  Dim elmMenuBar As IUIAutomationElement
  Dim elmTagDialog As IUIAutomationElement
  Dim elmCancelButton As IUIAutomationElement
  Dim elmViewMenu As IUIAutomationElement
  Dim elmViewMenu2 As IUIAutomationElement
  Dim elmToolMenu As IUIAutomationElement
  Dim elmToolMenu2 As IUIAutomationElement
  Dim elmRecMenu As IUIAutomationElement
  Dim elmRecTree As IUIAutomationElement
  Dim elmTreeChild As IUIAutomationElement
  Dim elmRecButton As IUIAutomationElement
  Dim elmRecDialog As IUIAutomationElement
  Dim elmAllPagesButton As IUIAutomationElement
  Dim elmOKButton As IUIAutomationElement
  Dim exptn As IUIAutomationExpandCollapsePattern
  Dim iptn As IUIAutomationInvokePattern
  Dim hAcrobat As Long
  Dim hAVScrollView As Long
  Const PDSaveFull = &H1
  Const FilePath As String = "C:\Test\OCR.pdf"
  Const SaveFilePath As String = "C:\Test\OCR2.pdf"
  
  'Acrobat起動
  Set appAcrobat = CreateObject("AcroExch.App")
  Set avdoc = CreateObject("AcroExch.AVDoc")
  avdoc.Open FilePath, ""
  appAcrobat.Show
  
  hAcrobat = FindWindowEx(0, 0, "AcrobatSDIWindow", vbNullString)
  If hAcrobat = 0 Then Exit Sub
  Set uiAuto = New CUIAutomation
  Set elmAcrobat = uiAuto.ElementFromHandle(ByVal hAcrobat)
  If elmAcrobat Is Nothing Then Exit Sub
  Set elmMenuBar = GetElement(uiAuto, _
                              elmAcrobat, _
                              UIA_NamePropertyId, _
                              "アプリケーション", _
                              UIA_MenuBarControlTypeId)
  If elmMenuBar Is Nothing Then Exit Sub
  
  '[タグ付けされていない文書の読み上げ]ダイアログが表示されたら閉じる
  Sleep 1000
  Set elmTagDialog = GetElement(uiAuto, _
                                uiAuto.GetRootElement, _
                                UIA_NamePropertyId, _
                                "タグ付けされていない文書の読み上げ", _
                                UIA_WindowControlTypeId)
  If Not elmTagDialog Is Nothing Then
    Set elmCancelButton = GetElement(uiAuto, _
                                     elmTagDialog, _
                                     UIA_NamePropertyId, _
                                     "キャンセル(C)", _
                                     UIA_ButtonControlTypeId)
    If Not elmCancelButton Is Nothing Then
      Set iptn = elmCancelButton.GetCurrentPattern(UIA_InvokePatternId)
      iptn.Invoke
    End If
  End If
  
  '[表示]メニューから[テキスト認識]表示
  Set elmViewMenu = GetElement(uiAuto, _
                               elmMenuBar, _
                               UIA_NamePropertyId, _
                               "表示(V)", _
                               UIA_MenuItemControlTypeId)
  If elmViewMenu Is Nothing Then Exit Sub
  Set exptn = elmViewMenu.GetCurrentPattern(UIA_ExpandCollapsePatternId)
  exptn.Expand
  Do
    Set elmViewMenu2 = uiAuto.RawViewWalker.GetFirstChildElement(elmAcrobat)
    Sleep 100
    DoEvents
  Loop Until elmViewMenu2.CurrentName = "表示(V)"
  Set elmToolMenu = GetElement(uiAuto, _
                               elmViewMenu2, _
                               UIA_NamePropertyId, _
                               "ツール(T)", _
                               UIA_MenuItemControlTypeId)
  If elmToolMenu Is Nothing Then Exit Sub
  Set exptn = elmToolMenu.GetCurrentPattern(UIA_ExpandCollapsePatternId)
  exptn.Expand
  Do
    Set elmToolMenu2 = uiAuto.RawViewWalker.GetFirstChildElement(elmAcrobat)
    Sleep 100
    DoEvents
  Loop Until elmToolMenu2.CurrentName = "ツール(T)"
  Set elmRecMenu = GetElement(uiAuto, _
                              elmToolMenu2, _
                              UIA_NamePropertyId, _
                              "テキスト認識(T)", _
                              UIA_MenuItemControlTypeId)
  If elmRecMenu Is Nothing Then Exit Sub
  Set iptn = elmRecMenu.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  
  '[テキスト認識]ツリー項目取得
  Do
    Set elmRecTree = GetElement(uiAuto, _
                                elmAcrobat, _
                                UIA_NamePropertyId, _
                                "テキスト認識", _
                                UIA_TreeItemControlTypeId)
    Set elmTreeChild = uiAuto.RawViewWalker.GetFirstChildElement(elmRecTree)
    Sleep 100
    DoEvents
  Loop Until elmTreeChild.GetCurrentPropertyValue(UIA_LegacyIAccessibleRolePropertyId) = &HA
  hAVScrollView = FindWindowEx(hAcrobat, 0, "AVL_AVView", "AVScrollView")
  
  '[このファイル内]ボタンフォーカス→Enterキーで実行
  Do
    Set elmRecButton = GetElement(uiAuto, _
                                  elmTreeChild, _
                                  UIA_HelpTextPropertyId, _
                                  "このファイル内のテキストを認識", _
                                  UIA_ButtonControlTypeId)
    Sleep 100
    DoEvents
  Loop While elmRecButton Is Nothing
  If elmRecButton Is Nothing Then Exit Sub
  elmRecButton.SetFocus
  PostMessage hAVScrollView, WM_KEYDOWN, vbKeyReturn, 0
  PostMessage hAVScrollView, WM_KEYUP, vbKeyReturn, 0
  
  '[テキスト認識]ダイアログ操作
  Do
    Set elmRecDialog = GetElement(uiAuto, _
                                  elmAcrobat, _
                                  UIA_NamePropertyId, _
                                  "テキスト認識", _
                                  UIA_WindowControlTypeId)
    Sleep 100
    DoEvents
  Loop While elmRecDialog Is Nothing
  If elmRecDialog Is Nothing Then Exit Sub
  Set elmAllPagesButton = GetElement(uiAuto, _
                                     elmRecDialog, _
                                     UIA_NamePropertyId, _
                                     "すべてのページ(A)", _
                                     UIA_RadioButtonControlTypeId)
  If elmAllPagesButton Is Nothing Then Exit Sub
  Set iptn = elmAllPagesButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  Set elmOKButton = GetElement(uiAuto, _
                               elmRecDialog, _
                               UIA_NamePropertyId, _
                               "OK", _
                               UIA_ButtonControlTypeId)
  If elmOKButton Is Nothing Then Exit Sub
  Set iptn = elmOKButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke '[OK]ボタンクリック
  '※ テキスト認識処理待ちはAcrobatにまかせる
  
  'Acrobat終了
  avdoc.GetPDDoc.Save PDSaveFull, SaveFilePath
  avdoc.Close 1
  appAcrobat.Hide: appAcrobat.Exit
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
  
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function

・・・後半、もう飽きました。
無理やり過ぎるので、実用性は正直皆無だと思います。

こんなコードで処理を自動化するよりは、Acrobat(Pro)の標準機能であるアクション(バッチ)機能を使用することをお薦めします。
(コードを載せておいてなんですが・・・)

関連記事

  1. Office アドイン

    [Office用アプリ]Google ドライブでアプリを公開する方法

    今回は先日登壇した第一回 Apps for Office 勉強会の中で…

  2. Office関連

    指定したセル範囲をUTF-8やEUC-JP等のテキストファイルとして出力するExcelアドイン

    以前この記事で、指定したセル範囲をUTF-8やEUC-JP等のテキスト…

  3. Office関連

    [Office 2013]サインインを無効にする。(2)

    前回の記事では「SignInOptions」の値を変更してサインインを…

  4. Office関連

    指定したセル範囲をUTF-8やEUC-JP等のテキストファイルとして出力するExcelマクロ

    ExcelファイルをUTF-8のテキストファイルで出力する必要があった…

  5. Office アドイン

    [Office用アプリ]野良アプリのススメ

    「Office 用アプリの概要」にもある通り、Office用アプリを公…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP