Home » 教育者向けの記事 » ICTの記事 » Wordの文章にルビ(ふりがな)を自動で振れるマクロ

Wordの文章にルビ(ふりがな)を自動で振れるマクロ

小学校の先生向けに、Wordの文章にルビ(ふりがな)を自動で振れるマクロを作成したので公開したいと思います。マクロ(プログラム)を追加する作業はちょっとだけ難しいですが、最初に一度でも設定をしてしまえば、あとはルビ振りをずっと自動化することができます。毎回プリントのルビ振りが大変だという先生は、ぜひご活用ください。(注意:今回のマクロはWindows限定です。)


【スポンサードリンク】

Wordにマクロを追加する手順

マクロを追加するための手順を説明します。適当なWordファイルを開いてツールバーの「表示」を選択し(①)、その中にある「マクロ」のアイコンをクリックします(②)。すると、マクロを操作するためのウィンドウが表示されます。

ウィンドウの中にあるマクロ名の箇所に適当な名前(例:test)を入力して(③)、右側の「作成」ボタンをクリックしてください(④)。すると、次のような「マクロを作成するためのウィンドウ」が表示されます。

上図の⑤枠に書かれている文字(マクロ)を全て削除し、その代わりに下の文字(マクロ)をコピー&ペーストしてください。

Option Explicit

'ルビを振った漢字を格納するArray
Public kanjiArray(9999) As String
'KanjiArrayのインデックス
Public KI As Long

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

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

'選択した範囲内の文字列にルビ設定(最初の漢字のみ)
Public Sub MakeFirstRubiPartial()
  SetPhoneticRange Selection.Range, True
End Sub

'文書全体にルビ設定(最初の漢字のみ)
Public Sub MakeFirstRubiAll()
  SetPhoneticRange ActiveDocument.Range, True
End Sub

Private Sub SetPhoneticRange(ByVal rng As Word.Range, ByVal FirstFlag As Boolean)
  Dim r As Word.Range
  Dim s As Word.Range
  Dim i As Long
  Dim dFlag As Boolean
  
  ' kanjiArrayのインデックスの初期化
  KI = 0
          
  '単語単位で処理
  For Each r In rng.Words
    'ルビが振られていないか最初にフィールド数で判定
    If r.Fields.Count < 1 Then
      ' 漢字が含まれているか判定
      If ChkKanjiRange2(r) = True Then
      
        ' 全部が漢字か判定
        If ChkKanjiRange(r) = True Then
        
          If FirstFlag = False Then
            ' 全ての漢字にルビをふる
            r.Select
            Application.Dialogs(wdDialogPhoneticGuide).Show 1
          Else
            ' 最初に出てきた漢字にだけルビをふる
            If inKanjiArray(r.Text) = False Then
              addKanjiArray (r.Text)
              r.Select
              Application.Dialogs(wdDialogPhoneticGuide).Show 1
            End If
          End If
        
        Else
          '文字単位で処理
          i = 1
          For Each s In r.Characters
            ' 漢字か判定
            If ChkKanjiRange(s) = True Then
              ' 次の文字が漢字か判定
              dFlag = False
              If i < Len(r.Text) And Len(Mid(r.Text, i + 1, 1)) > 0 Then
                If isKanji(Mid(r.Text, i + 1, 1)) = True Then
                  ' 漢字が2文字続きの場合、一緒にルビを振る
                  s.End = s.End + 1
                  dFlag = True
                End If
              End If
              
              If FirstFlag = False Then
                ' 全ての漢字にルビをふる
                s.Select
                Application.Dialogs(wdDialogPhoneticGuide).Show 1
              Else
                ' 最初に出てきた漢字にだけルビをふる
                If inKanjiArray(s.Text) = False Then
                  If dFlag = True Then
                    addKanjiArray (Mid(r.Text, i, 1))
                    addKanjiArray (Mid(r.Text, i + 1, 1))
                  End If
                  addKanjiArray (s.Text)
                  s.Select
                  Application.Dialogs(wdDialogPhoneticGuide).Show 1
                End If
              End If
              
            End If
            i = i + 1
          Next
        End If

      End If
    End If
  Next
End Sub
Private Function ChkKanjiRange(ByVal rng As Word.Range) As Boolean
'指定したRangeが全部漢字だったらTrue
  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 ChkKanjiRange2(ByVal rng As Word.Range) As Boolean
'指定したRangeに漢字が1文字でも含まれていたらTrue
  Dim ret As Boolean
  Dim i As Long
   
  ret = False
  For i = 1 To Len(rng.Text)
    If isKanji(Mid(rng.Text, i, 1)) = True Then
      ret = True
      Exit For
    End If
  Next
  ChkKanjiRange2 = ret
End Function

Private Function isKanji(ByVal strIn As String) As Boolean
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "[一-龠〃々〆〇]"

    If re.test(strIn) Then
        'MsgBox "入力文字列には、漢字が含まれてます。"
        isKanji = True
    Else
        'MsgBox "入力文字列には、漢字が含まれていません。"
        isKanji = False
    End If
End Function

Private Function inKanjiArray(ByVal str As String) As Boolean
  Dim ret As Boolean
  Dim i As Long
  ret = False
  
  For i = 0 To KI + 1
    If StrComp(kanjiArray(i), str) = 0 Then
      ret = True
      Exit For
    End If
  Next
  inKanjiArray = ret
End Function

Private Function addKanjiArray(ByVal str As String) As Boolean
  kanjiArray(KI) = str
  KI = KI + 1
End Function

⑤の入力が終わったら、ツールバーの「ファイル」から「上書き保存」をクリックします。これでマクロの追加ができましたので、「マクロを作成するためのウィンドウ」を閉じてしまって大丈夫です(⑦)。

ルビ振りマクロの使い方

ルビ振りマクロの使い方を紹介します。ルビ振りを行いたいWordファイルを開いたら、ツールバーの「表示」を選択し(①)、その中にある「マクロ」のアイコンをクリックします(②)。すると、マクロを操作するためのウィンドウが表示されます。

実行したいマクロを③の中から選び、右側の「実行」ボタンをクリック(④)したらルビ振りを行うことができます。③で選べるマクロは全部で4種類あります。

  • MakeRubiAll文書全ての漢字にルビを振るマクロ
  • MakeRubiPartialマウスで選択された範囲内の漢字にルビを振るマクロ
  • MakeFirstRubiAll:文書全ての漢字にルビを振るマクロ前出の漢字は省く
  • MakeFirstRubiPartial:マウスで選択された範囲内の漢字にルビを振るマクロ(前出の漢字は省く

マクロを実行すると、次のようにルビ振りを全て自動で行ってくれます。下の画像は、MakeFirstRubiAll を実行した結果です。(ルビが一度振られた漢字は、二度目以降は振られていないのが分かります。)

余談

今回のマクロを作成するにあたり、初心者備忘録さんのブログを参考にさせていただきました。改めて感謝申し上げます。

初心者備忘録さんとの大きな違いは、漢字判定のアルゴリズムを正規表現に変更したところとバグの修正、ルビの精度向上、それに前出漢字のルビ振りを省略するアルゴリズムを追加したところです。

普段はPythonやVueなどの優れたプログラミング言語を使っているため、今回使用したVBAというプログラミング言語はとても使い辛くて苦労しました。コードも汚いしリファクタリングもしていないので、同業者のエンジニアにコードを見られるとちょっと恥ずかしいですね。

とはいえ、Wordだけでルビ振りが完結するマクロはこれまで作られていなかったので、苦労して作っただけの価値はあると思っています。Wordのルビ振りで苦労している人たちの助けになれば幸いです。