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 続編を書きました。

関連記事

  1. Office関連

    [Office 2016]コマンド検索即実行、便利な「Tell Me」機能

    ※ 下記情報はOffice 2016 Preview版を元にしています…

  2. Office関連

    ヘッドレス ChromeをSeleniumBasicで動かしてみました。

    Chromeがヘッドレスモードに対応した頃、Seleniumで操作した…

  3. Office関連

    [Office 365 Solo]日本語環境以外では使えるの?

    Office 365 Soloを使ってみて、疑問に思ったことの一つが“…

  4. Office アドイン

    [Office用アプリ]選択範囲変更時のイベントを利用する。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  5. Microsoft Teams

    Microsoft Teamsでタブの構築を試してみました。

    下記記事の通り、Office 365に新たなコラボレーションツール「M…

  6. Office関連

    選択したセルに連続行番号を振るWordマクロ

    Wordでマニュアルを作成するとき等、表の中で連番を振りたいときがよく…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP