Office関連

[Word VBA]ルビ(ふりがな)ダイアログの操作に挑む

2016/10/28 追記:
改良版のマクロを書きました。


Wordでルビ振りを一括で行いたい」、こういった要望は昔からよくあり、これまで様々な手法が紹介されてきました。

当ブログでも「ルビ(ふりがな)を一括設定するWordマクロ」でExcelのGetPhoneticメソッドを使ったマクロを紹介していますが、問題なのが性能の低さ。

単語単位ではまだしも漢字一文字だけの処理となると、前後の文脈が無いためか、たとえば「合わせて」の部分が「合(ごう)わせて」のように、まともにふりがなを取得できません。

その点Word既存の「ルビ」機能であれば、下図のようにちゃんとしたふりがなを取得することができます。

PhoneticDialog_Automation_01_01

であれば、このルビ機能を利用したマクロを作れば良いのですが、この記事でも書いた通り、ルビダイアログ(wdDialogPhoneticGuide)にはオプションがないため、「Word の組み込みのダイアログ ボックスを表示する」に書かれている方法でふりがなを取得することはできません。

そしてダイアログから直接取得しようにも、このダイアログは“モーダルダイアログ”であるため、ダイアログが開かれた瞬間にマクロは停止してしまいます。

SendKeysを使ってダイアログにキーストロークを送る方法もありますが、安定性の面を考えるとあまり使いたくはありません。

それでは一体どうするか?答えは簡単。

“UI Automationでダイアログを操作するマクロを非同期で実行する”

ことです。
(もちろん他の方法もあるだろうと思いますが、いろいろ考えるのも面倒なので直球勝負でいきます。)

「ルビ」ダイアログを操作するWordマクロ

※ [ThisDocument]に記述
※ UIAutomationClient(UIAutomationCore.dll)要参照

'ThisDocument
Option Explicit

Private d As Object

Public Sub Sample()
  If Selection.Start <> Selection.End Then
    Set d = CreateObject("htmlfile")
    Set d.parentWindow.onhelp = Me
    d.parentWindow.SetTimeout "onhelp.ExecSetPhoneticDialog()", 100, "VBScript" 'setTimeoutで時間差実行
    Application.Dialogs(wdDialogPhoneticGuide).Show
  End If
End Sub

Public Sub ExecSetPhoneticDialog(Optional ByVal dummy As Long = 0)
'文字単位,右揃え,オフセット:20,フォント:メイリオ,フォントサイズ:15
  SetPhoneticDialog False, False, "右揃え", 20, "メイリオ", 15
End Sub

Private Sub SetPhoneticDialog(Optional ByVal flgClearReadingsButton As Boolean = False, _
                              Optional ByVal flgGroup As Boolean = True, _
                              Optional ByVal alignmentValue As String = "", _
                              Optional ByVal offsetValue As Long = 0, _
                              Optional ByVal fontValue As String = "", _
                              Optional ByVal sizeValue As Long = 0)
'[ルビ]ダイアログ操作
'※UIAutomationClient(UIAutomationCore.dll)要参照
'  引数説明
'    flgClearReadingsButton : True : ルビの解除
'    flgGroup : True : 文字列全体, False : 文字単位
'    alignmentValue : 配置
'    offsetValue : オフセット
'    fontValue : フォント
'    sizeValue : サイズ
  
  Dim uiAuto As CUIAutomation
  Dim elmRoot As IUIAutomationElement
  Dim elmPhoneticDialog As IUIAutomationElement 'ルビダイアログ
  Dim elmGroupButton As IUIAutomationElement '文字列全体
  Dim elmMonoButton As IUIAutomationElement '文字単位
  Dim elmClearReadingsButton As IUIAutomationElement 'ルビの解除
  Dim elmOkButton As IUIAutomationElement 'OK
  Dim elmAlignmentComboBox  As IUIAutomationElement '配置
  Dim elmRubyEdit As IUIAutomationElement 'ルビ
  Dim elmOffsetEdit As IUIAutomationElement 'オフセット
  Dim elmFontEdit As IUIAutomationElement 'フォント
  Dim elmSizeEdit As IUIAutomationElement 'サイズ
  Dim accAlignmentComboBox As IAccessible
  Dim aptn As IUIAutomationLegacyIAccessiblePattern
  Dim vptn As IUIAutomationValuePattern
  Dim iptn As IUIAutomationInvokePattern
  Dim i As Long
  
  Set uiAuto = New CUIAutomation
  Set elmRoot = uiAuto.GetRootElement
  
  '[ルビ]ダイアログ取得
  While elmPhoneticDialog Is Nothing
    Set elmPhoneticDialog = GetElement(uiAuto, elmRoot, UIA_NamePropertyId, "ルビ", UIA_WindowControlTypeId)
    DoEvents
  Wend
  '[文字列全体]ボタン取得
  Set elmGroupButton = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "文字列全体(G)", UIA_ButtonControlTypeId)
  '[文字単位]ボタン取得
  Set elmMonoButton = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "文字単位(M)", UIA_ButtonControlTypeId)
  '[ルビの解除]ボタン取得
  Set elmClearReadingsButton = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "ルビの解除(C)", UIA_ButtonControlTypeId)
  '[OK]ボタン取得
  Set elmOkButton = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "OK", UIA_ButtonControlTypeId)
  '[配置]コンボボックス取得
  Set elmAlignmentComboBox = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "配置(L):", UIA_ComboBoxControlTypeId)
  '[ルビ]エディットボックス取得
  Set elmRubyEdit = GetElement(uiAuto, elmPhoneticDialog, UIA_AutomationIdPropertyId, "19")
  '[オフセット]エディットボックス取得
  Set elmOffsetEdit = GetElement(uiAuto, elmPhoneticDialog, UIA_AutomationIdPropertyId, "35")
  '[フォント]エディットボックス取得
  Set elmFontEdit = GetElement(uiAuto, elmPhoneticDialog, UIA_AutomationIdPropertyId, "1792")
  '[サイズ]エディットボックス取得
  Set elmSizeEdit = GetElement(uiAuto, elmPhoneticDialog, UIA_AutomationIdPropertyId, "1796")
  
  '[ルビの解除]ボタンクリック
  If flgClearReadingsButton = True Then
    Set iptn = elmClearReadingsButton.GetCurrentPattern(UIA_InvokePatternId)
    iptn.Invoke
  End If
  '[文字単位]設定
  If flgGroup = False Then
    Set iptn = elmMonoButton.GetCurrentPattern(UIA_InvokePatternId)
    iptn.Invoke
  End If
  
  '[配置]コンボボックス設定
  If alignmentValue <> "" Then
    Select Case alignmentValue
      Case "中央揃え", "均等割り付け 1", "均等割り付け 2", "左揃え", "右揃え"
        Set aptn = elmAlignmentComboBox.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
        Set accAlignmentComboBox = aptn.GetIAccessible
        For i = 1 To accAlignmentComboBox.accChildCount
          If accAlignmentComboBox.accName(i) = alignmentValue Then
            accAlignmentComboBox.accDoDefaultAction i
            Exit For
          End If
        Next
    End Select
  End If
  
  '[オフセット]エディットボックス設定
  If offsetValue <> 0 Then
    Set vptn = elmOffsetEdit.GetCurrentPattern(UIA_ValuePatternId)
    vptn.SetValue CStr(offsetValue)
  End If
  '[フォント]エディットボックス設定
  If fontValue <> "" Then
    Set vptn = elmFontEdit.GetCurrentPattern(UIA_ValuePatternId)
    vptn.SetValue fontValue
  End If
  '[サイズ]エディットボックス設定
  If sizeValue <> 0 Then
    Set vptn = elmSizeEdit.GetCurrentPattern(UIA_ValuePatternId)
    vptn.SetValue CStr(sizeValue)
  End If
  
  If Len(Trim(elmRubyEdit.GetCurrentPropertyValue(UIA_ValueValuePropertyId))) < 1 Then
    elmRubyEdit.SetFocus
  Else
    '[OK]ボタンクリック
    Set iptn = elmOkButton.GetCurrentPattern(UIA_InvokePatternId)
    iptn.Invoke
  End If
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)
  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

PhoneticDialog_Automation_01_02

上図の通り、マクロを実行すると、一瞬だけルビダイアログが表示されますが、引数で指定した項目通りに設定を行って、OKボタンでダイアログが閉じられます。
あとはこのマクロを連続で実行すれば、ふりがなの一括設定が行えるはずですが、ここで一つ問題が…。

PhoneticDialog_Automation_01_03

Word 2016だとUI Automationによる操作はできているはずなのにフォント等の設定がリセットされるのです。

まさかの落とし穴・・・。
さすが“ルビ”ダイアログ。

とりあえず、今回はここまで。
引き続き、このダイアログの操作に挑んでみたいと思います。

2015/10/22 続編を書きました。

ドラッグ&ドロップした画像をクリップボードにコピーするバッチファイル前のページ

[Word VBA]ルビ(ふりがな)ダイアログの操作に挑む(2)次のページ

関連記事

  1. Office アドイン

    [Office用アプリ]日経パソコン 2013/8/26号 の記事

    日経パソコン 2013/8/26号 のニュース&トレンドにOffice…

  2. Office アドイン

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

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

  3. Office アドイン

    [Officeアドイン]地図記号挿入アドイン

    ちょっとずつ作成していたWord用のOffice アドインがようやくO…

  4. アイコン一覧

    Office 365アイコン(imageMso)一覧(C)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  5. アイコン一覧

    Office 2013 アイコン一覧(M)

    ・Office 2013 アイコン一覧 NUM…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP