これまで当ブログではルビを設定するWordマクロについて、いくつか記事を書いてきました。

2014.07.02

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

2016/10/28 追記： 改良版のマクロを書きました。 Wordの標準機能ではルビ(ふりがな)を一括設定できない、ということを最近知ったので、マクロで処理できないか色々調べてみました。 まずは関連がありそうなメソッドですが、W...

2015.10.22

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

2016/10/28 追記： 改良版のマクロを書きました。 「Wordでルビ振りを一括で行いたい」、こういった要望は昔からよくあり、これまで様々な手法が紹介されてきました。 Word2003で作成した文書に一括でルビをふる...

2015.10.22

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

2016/10/28 追記： 改良版のマクロを書きました。 前回の記事では、Wordのルビダイアログの操作に挑んで見事につまづいたわけですが、対処は簡単です。 配置やオフセット、フォントといったオプションの設定で上手くいかないのであれ...

それらはExcelを利用するものであったり、ルビダイアログを無理やり操作するものであったりして、あまり実用的ではないレベルのマクロでした。

そして今日たまたま気が付いたのがDialogオブジェクトのShowメソッドの引数。

Timeout(省略可能)：ダイアログ ボックスを自動的に閉じるまでの時間を指定します。基本となる単位は約 0.001 秒です。システム アクティビティを同時に実行すると、有効時間の値が増えます。この引数を省略した場合、ユーザーがダイアログ ボックスを閉じたときにダイアログ ボックスは閉じます。

こんなのあったのか！
Wordマクロを触って何年か経ちますが、まったく気が付きませんでした。
これ使えばこの記事でやっているような、モーダルダイアログの操作とか要らないじゃん！！
・・・まったく、自分の無知さに呆れ果てます。

とはいえ、これで上記記事のコードも大分改善されるので、マクロを書き直すことにしました。

Option Explicit
 
Public Sub Sample01()
'選択した範囲内の文字列にルビ設定
  SetPhoneticRange Selection.Range
End Sub

Public Sub Sample02()
'文書全体にルビ設定
  SetPhoneticRange ActiveDocument.Range
End Sub

Private Sub SetPhoneticRange(ByVal rng As Word.Range)
'指定した範囲のルビ一括設定
  Dim r As Word.Range
 
  '単語単位で処理
  For Each r In rng.Words
    'ルビが振られていないか最初にフィールド数で判定
    If r.Fields.Count < 1 Then
      If ChkKanjiRange(r) = True Then
        r.Select
        Application.Dialogs(wdDialogPhoneticGuide).Show 1
      End If
    End If
  Next
 
  '文字単位で処理
  For Each r In rng.Characters
    'ルビが振られていないか最初にフィールド数で判定
    If r.Fields.Count < 1 Then
      If ChkKanjiRange(r) = True Then
        r.Select
        Application.Dialogs(wdDialogPhoneticGuide).Show 1
      End If
    End If
  Next
End Sub
 
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
'漢字判別
'※ 参考Webページ
' - http://www.taishukan.co.jp/kokugo/webkoku/series003_04.html
' - http://en.wikipedia.org/wiki/CJK_Unified_Ideographs_%28Unicode_block%29
' - http://www.asahi-net.or.jp/~ax2s-kmtn/ref/unicode/e_asia.html
' - http://www.gsid.nagoya-u.ac.jp/ohna/notes/nu/regex4kanji2.txt
' - http://support.microsoft.com/kb/161304/ja
  Dim cc As Variant
  Dim ret As Boolean
  
  ret = True '初期化
  cc = Val("&H" & Hex(AscW(char)) & "&")
  Select Case cc
    Case 63744 To 64255   'CJK互換漢字(U+F900-U+FAFF)
    Case 13312 To 19903   'CJK統合漢字拡張A(U+3400-U+4DBF)
    Case 19968 To 40959   'CJK統合漢字(U+4E00-U+9FFF)
    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 194560 To 195103 'CJK互換漢字補助(U+2F800-U+2FA1F)
    Case Else
      ret = False
  End Select
  IsKanji = ret
End Function

やっていることはこれまでの記事と大して変わりはありません。
文字コードで漢字かどうかを判別して、漢字の場合のみルビダイアログを使って、ルビ設定を行っています。

ただ、Word 2010で試したところ、いくつかの文字列でルビ設定に失敗してしまうようでした。
失敗してしまう原因については掴みきれていませんが、そのうち修正できたら修正します。