Office関連

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

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


前回の記事では、Wordのルビダイアログの操作に挑んで見事につまづいたわけですが、対処は簡単です。
配置やオフセット、フォントといったオプションの設定で上手くいかないのであれば、ダイアログでそれらの設定を行わなければ良いわけです。

'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.SetPhoneticDialog()", 100, "VBScript" 'setTimeoutで時間差実行
    Application.Dialogs(wdDialogPhoneticGuide).Show
  End If
End Sub

Public Sub SetPhoneticDialog(Optional ByVal dummy As Long = 0)
'[ルビ]ダイアログ操作
'※UIAutomationClient(UIAutomationCore.dll)要参照
  
  Dim uiAuto As CUIAutomation
  Dim elmRoot As IUIAutomationElement
  Dim elmPhoneticDialog As IUIAutomationElement 'ルビダイアログ
  Dim elmOkButton As IUIAutomationElement 'OK
  Dim elmRubyEdit As IUIAutomationElement 'ルビ
  Dim iptn As IUIAutomationInvokePattern
  
  Set uiAuto = New CUIAutomation
  Set elmRoot = uiAuto.GetRootElement
  
  '[ルビ]ダイアログ取得
  While elmPhoneticDialog Is Nothing
    Set elmPhoneticDialog = GetElement(uiAuto, elmRoot, UIA_NamePropertyId, "ルビ", UIA_WindowControlTypeId)
    DoEvents
  Wend
  '[OK]ボタン取得
  Set elmOkButton = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "OK", UIA_ButtonControlTypeId)
  '[ルビ]エディットボックス取得
  Set elmRubyEdit = GetElement(uiAuto, elmPhoneticDialog, UIA_AutomationIdPropertyId, "19")
  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

上記の通り、“OKボタンを押す操作だけ”行うようにした結果、前回の記事のコードに比べて大分シンプルになりました。
前回つまづいたWord 2016での動作も問題ありません。

これでようやくルビダイアログが操作できるようになったので、あとは一括ふりがな設定をするべく、マクロを連続で実行するだけです。

選択範囲にある漢字にルビを一括設定するWordマクロ

連続で実行と言っても、処理手順は「ルビ(ふりがな)を一括設定するWordマクロ」で書いている通り、“単語単位で列挙していき、単語が漢字である場合にルビを設定、漏れ防止に文字単位で列挙していき、文字が漢字である場合にルビを設定”していけば良いだけです。

'ThisDocument
Option Explicit

Private d As Object

Public Sub Sample2()
  Dim sel As Word.Range
  Dim r As Word.Range
  
  Set d = CreateObject("htmlfile")
  Set d.parentWindow.onhelp = Me
  Set sel = Selection.Range
  
  '単語単位で処理
  For Each r In sel.Words
    If ChkKanjiRange(r) = True Then
      r.Select
      d.parentWindow.SetTimeout "onhelp.SetPhoneticDialog()", 100, "VBScript" 'setTimeoutで時間差実行
      Application.Dialogs(wdDialogPhoneticGuide).Show
    End If
  Next
  
  '文字単位で処理
  For Each r In sel.Characters
    If IsKanji(r.Text) = True Then
      r.Select
      d.parentWindow.SetTimeout "onhelp.SetPhoneticDialog()", 100, "VBScript" 'setTimeoutで時間差実行
      Application.Dialogs(wdDialogPhoneticGuide).Show
    End If
  Next
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Public Sub SetPhoneticDialog(Optional ByVal dummy As Long = 0)
'[ルビ]ダイアログ操作
'※UIAutomationClient(UIAutomationCore.dll)要参照
  
  Dim uiAuto As CUIAutomation
  Dim elmRoot As IUIAutomationElement
  Dim elmPhoneticDialog As IUIAutomationElement 'ルビダイアログ
  Dim elmOkButton As IUIAutomationElement 'OK
  Dim elmRubyEdit As IUIAutomationElement 'ルビ
  Dim iptn As IUIAutomationInvokePattern
  
  Set uiAuto = New CUIAutomation
  Set elmRoot = uiAuto.GetRootElement
  
  '[ルビ]ダイアログ取得
  While elmPhoneticDialog Is Nothing
    Set elmPhoneticDialog = GetElement(uiAuto, elmRoot, UIA_NamePropertyId, "ルビ", UIA_WindowControlTypeId)
    DoEvents
  Wend
  '[OK]ボタン取得
  Set elmOkButton = GetElement(uiAuto, elmPhoneticDialog, UIA_NamePropertyId, "OK", UIA_ButtonControlTypeId)
  '[ルビ]エディットボックス取得
  Set elmRubyEdit = GetElement(uiAuto, elmPhoneticDialog, UIA_AutomationIdPropertyId, "19")
  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

Private Function ChkKanjiRange(ByVal rng As Word.Range) As Boolean
'指定したRangeが漢字のみかチェック
  Dim ret As Boolean
  Dim i As Long
  
  ret = True
  For i = 1 To Len(rng.Text)
    If IsKanji(Mid(rng.Text, i, 1)) = False Then
      ret = False
      Exit For
    End If
  Next
  ChkKanjiRange = ret
End Function

Private Function IsKanji(ByVal char As String) As Boolean
'漢字判別
  Dim cc As Variant
  Dim ret As Boolean
  
  ret = True '初期化
  cc = Val("&H" & Hex(AscW(char)) & "&")
  Select Case cc
    Case 19968 To 40959   'CJK統合漢字(U+4E00-U+9FFF)
    Case 13312 To 19903   'CJK統合漢字拡張A(U+3400-U+4DBF)
    Case 131072 To 173791 'CJK統合漢字拡張B(U+20000-U+2A6DF)
    Case 173824 To 177983 'CJK統合漢字拡張C(U+2A700-U+2B73F)
    Case 177984 To 178207 'CJK統合漢字拡張D(U+2B740-U+2B81F)
    Case 63744 To 64255   'CJK互換漢字(U+F900-U+FAFF)
    Case 194560 To 195103 'CJK互換漢字補助(U+2F800-U+2FA1F)
    Case Else
      ret = False
  End Select
  IsKanji = ret
End Function

仕組みとしては上記コードで問題なく処理できるはずです。
・・・が、いざ実行してみると、

PhoneticDialog_Automation_02_02

上図のようにふりがなが表示されない文字列が出てくるのです。
(手動でダイアログを表示した場合は、問題なくふりがな表示されるので原因は不明)

Word 2016では問題なく実行できるので(下図参照)、恐らくはIME等の実行環境に原因があるのだと思いますが、これ以上はさすがに調べるのが面倒なので、このあたりで妥協しておきます。

PhoneticDialog_Automation_02_01

そんなわけで、結局ExcelのGetPhoneticメソッドを使う方法とどちらがマシなのか分からないくらい中途半端なコードになってしまいましたが、一応ルビダイアログの操作はできた、ということで、今回は終わりにしたいと思います。

関連記事

  1. アイコン一覧

    Office 2013 アイコン一覧(V)

    ・Office 2013 アイコン一覧 NUM…

  2. Office関連

    Wordのテンプレートをインストールするスクリプト

    Wordマクロをテンプレートにして使用する場合、通常そのテンプレートフ…

  3. Office関連

    Word 2013のアクセス キー一覧[PDF]

    前回の記事でWord 2013のアクセス キーをまとめたものを公開しま…

  4. アイコン一覧

    Office 2013 アイコン一覧(A)

    ・Office 2013 アイコン一覧 NUM…

  5. アイコン一覧

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

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

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP