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

ホーム
Office関連, Word
[Word VBA]ルビ(ふりがな)ダイアログの操作に挑む

Office関連

2015.10.22

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

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

2016.10.28

ルビ(ふりがな)を一括設定するWordマクロ(改良版)

これまで当ブログではルビを設定するWordマクロについて、いくつか記事を書いてきました。それらはExcelを利用するものであったり、ルビダイアログを無理やり操作するものであったりして、あまり実用的ではないレベルのマクロでした。 ...

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

Word2003で作成した文書に一括でルビをふる方法
https://groups.google.com/forum/#!topic/microsoft.public.jp.word/ZNstY3ap7V8
ルビをカタカナでつける方法
http://microsoft.public.jp.word.narkive.com/FJ2m9feU
全文ルビ振り(07/11/25)
http://homepage2.nifty.com/miyahn/
高速ルビ（Word VBAによるマクロ）
https://sites.google.com/site/osamumimura/home/ruby
ルビ一括変換　（Word VBA)
http://www2s.biglobe.ne.jp/~Taiju/leaf/tjsoft81_Ruby_Auto.htm
ルビふり君for Word（2000-2003対応）
http://www.turtle-west.co.jp/Soft6.htm
振の玉 for Word
http://www.vector.co.jp/soft/win95/writing/se161760.html
自動ルビ振り for Word
http://www.vector.co.jp/soft/winnt/writing/se504700.html

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

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

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

であれば、このルビ機能を利用したマクロを作れば良いのですが、この記事でも書いた通り、ルビダイアログ(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