Office関連

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

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


Wordの標準機能ではルビ(ふりがな)を一括設定できない、ということを最近知ったので、マクロで処理できないか色々調べてみました。

まずは関連がありそうなメソッドですが、WordのRangeオブジェクトには指定範囲にルビを追加する、そのものずばりのPhoneticGuideメソッドが用意されています。

Word_Phonetic_01

ただし、上図の通り追加するルビ文字列を指定する「Text」パラメータが必須となっているため、自分でルビを設定する必要があります。

ここで気になったのがWordの「ルビ」機能で、この機能を実行すると、自分でルビを設定することなく、下図のように自動的にルビが設定されます。

Word_Phonetic_02

この自動的に設定されるルビを何らかの方法で取得できれば、PhoneticGuideメソッドを活かすことができそうです。

早速、ダイアログ ボックスの設定値を取得するための引数を「組み込みのダイアログ ボックスの引数一覧 (Word)」で調べてみました。

Word_Phonetic_03

・・・が、上図の通りwdDialogPhoneticGuideには引数がありませんでした。

仕方がないので「ルビ」を実行したときにWordがどのような動きをしているのかをProcess Explorerで調べたところ、どうやらWord 2010ではimjp14k.dllの「CreateIImeGrammarInstance」関数が呼ばれているようでした。

Word_Phonetic_04

imjp14k.dllはIMEで使われているDLLなので、恐らくはIMEを利用してルビを取得しているだろうことは分かったのですが、呼ばれている関数が分かったところでCreateIImeGrammarInstance関数について調べても目ぼしい情報が出てきませんでしたので、ルビを取得する関数を直接呼び出す方法は諦めることにしました。

そこで目を付けたのがExcelのApplicationオブジェクトにあるGetPhoneticメソッドです。
このメソッドは指定した文字列の日本語のふりがなを取得するもので、挙動を調べたところ、Wordのルビと同様imjp14k.dllのCreateIImeGrammarInstance関数が呼び出されているようでした。

“ExcelのGetPhoneticメソッドで取得したルビをWordのPhoneticGuideメソッドで設定する”

という方向が決まったところで書いたのが下記コードになります。
(Wordのルビダイアログから直接取得する方法も考えましたが、面倒なので止めました。)

Option Explicit

Public Sub SetPhoneticDocument()
'ルビ一括設定
  Dim r As Word.Range
  Dim pntc As String
  
  With CreateObject("Excel.Application")
    .Visible = True
    '単語単位で処理
    For Each r In ActiveDocument.Words
      If ChkKanjiRange(r) = True Then
        pntc = .GetPhonetic(r.Text)
        r.PhoneticGuide StrConv(pntc, vbHiragana)
      End If
    Next
    '文字単位で処理
    For Each r In ActiveDocument.Characters
      If ChkKanjiRange(r) = True Then
        pntc = .GetPhonetic(r.Text)
        r.PhoneticGuide StrConv(pntc, vbHiragana)
      End If
    Next
    .Quit
  End With
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)) & "&")
  'Debug.Print "CHK:" & cc
  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

まずは単語単位で列挙していき、単語が漢字である場合にルビを設定、漏れ防止に文字単位で列挙していき、文字が漢字である場合にルビを設定する、といった処理を行っています。

Word_Phonetic_05

漢字であるかどうかの判別は文字コードで行っていますが、簡易的に書いただけなので抜けはあるかもしれません。
また、PhoneticGuideメソッドのオプションも特に指定していないため、フォントの位置やサイズを指定する場合はコードを追加する必要があります。

というわけで、完璧にルビを設定することはできませんが、大まかには設定することができますので、大量のルビ設定にお困りの方は一度お試しください。
なお、上記の通りルビの取得にExcelの機能を利用しているため、上記マクロの動作にはExcelが必須となります。


2015/10/22 追記:

ダイアログを操作してふりがなを振るマクロについての記事も書きました。

関連記事

  1. アイコン一覧

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

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

  2. アイコン一覧

    Office 2013 アイコン一覧(C)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    Office 2013の開発者用リファレンス

    「Word2013 VBA の日本語ヘルプ」でも回答していますが、Of…

  4. Office関連

    指定したフォルダ内にあるExcelファイルを一つにまとめるVBAマクロ

    複数あるファイルを一つにまとめるにはどうすれば良いか?という質問をいた…

  5. Office関連

    「最速攻略 Wordマクロ/VBA徹底入門」レビュー

    いつもお世話になっているExcel MVPの伊藤さんに9月20日発売予…

  6. Office関連

    Office 365 Soloをインストールしみてました。

    2014年10月17日、Microsoftの新しいOffice製品「O…

コメント

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

  1. 2018年 11月 16日
    トラックバック:発音記号を簡単に入力したい

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP