見出し画像

10秒で大量の文章にルビ(読み仮名)を振る【Word】

皆さんこんにちは😃前ネコです。

以前、『Wordの文章に30秒でルビを振る』という記事を公開しました。

今回の記事は、そちらの方法とは少し違った方法でWordのルビ振りの方法を紹介します。

※こちらの方法は、ワーママ先生より紹介していただいています。

ワーママ先生は、HICT(#全国変態ICT効率化委員会)の委員長です。Xを利用している方は、こちらのコミュニティもご覧ください。


1導入前に

以前紹介したツールと、今回紹介するツールは、それぞれルビの振り方にメリット、デメリットがあります。

新しいルビ振りの方法は,処理速度や日常の使いやすさが優秀である半面,ルビの正確さはそこまで高くないということに気を付けてください。ひらがな上にも、図のようにルビが振られます。

実際の処理後の画面

ですので、今回の方法は、『見直し前提』ということになります。保護者へのおたよりや出版などの、ルビ振りの正確さが求められる場合は、以前紹介した方法がおすすめです。

2 ルビ振りの仕組み

『仕組み難しいから、方法早く教えてほしい!』という人は、次のステップへスキップしてくださいね(^ω^)

Wordのルビ振りは、IMEを使ってルビ変換しています。

以下Copilotよりーーーーー

IME(日本語入力システム)の読み情報

• Wordは、選択された漢字の入力履歴や変換候補をもとに、IMEから取得した読み仮名を使ってルビを推測します。
• たとえば「屋根裏」と入力したとき、IMEが「やねうら」と認識していれば、それがそのままルビ候補になります。

📌 注意点:IMEの学習状況や変換履歴によって、誤った読みが表示されることもあります。

ーーーーーーーーーーー

このIMEを読み込む際、Wordは文脈を読み取ります。その文脈の読み取りの処理がとても多いため、ルビ振りに時間がかかります。

その問題を解決するために、Excelのルビ振り機能を、Wordに取り入れていきます。

エクセルのルビ振り機能は、Wordより速いです。

—以下Copilot より

🧠 なぜExcelの方が速いのか?

• Excelはセルに入力した瞬間のIME情報を保持しており、PHONETIC関数で即座に読みを抽出できます。
• Wordは選択範囲に対してIME+文脈解析+ルビダイアログ描画を行うため、処理が重くなりがちです。
• Word VBAでは、`PhoneticGuide`を使うたびに再描画と再計算が発生するため、ループ処理では特に遅くなります。

---

ということで、Wordのルビ振りにExcelの機能を利用して爆速にしちゃおう作戦で今回は進めていきます。

※何度も言いますが、この作戦はワーママ先生のアイデアです。

3 初期設定

※今回紹介する方法は、デスクトップ版のWordのみ機能します。Mac版やスマホ、タブレット版アプリでは、正常に機能しません。

1 Wordに『開発』タブを出す


ファイル⇒その他⇒オプションを選択

リボンのユーザー設定⇒開発にチェック

2 開発タブから、『Visual Basic』を選択する

3 ツールの参照設定を選択→Microsoft Excel 〇.〇・・・にチェックをつける

バージョンが変わることがあり後ろの数字が変わることもあります。



4 モジュールをノーマルに設置する

挿入からモジュール追加→ノーマルに追加することで、全Wordに反映される。

5 モジュールにコードを貼り付ける

下記のプログラムをコピペする。

'================================================================================
' 【選択範囲のみ】Word文書の漢字に自動でルビを振るマクロ【フリーズ対策版】
'================================================================================
Sub AutoRubyForSelection_Final()

    ' --- 設定項目 ---
    Const RubySize As Long = 6   ' ルビのフォントサイズ
    Const RubyOffset As Long = 10 ' 文字からの距離(オフセット)
    ' ----------------

    Dim excelApp As Object
    Dim targetRange As Range
    Dim word As Range
    Dim reading As String
    Dim originalText As String
    Dim kanjiPart As String
    Dim okuriganaPart As String
    Dim rubyText As String
    Dim kanjiRange As Range
    Dim lastKanjiIndex As Long
    Dim i As Long
    Dim progress As Long
    Dim totalWords As Long

    ' ★★★ 変更点 ★★★
    ' 範囲が選択されているかチェックする
    If Selection.Type = wdSelectionIP Or Selection.Range.Characters.Count < 2 Then
        MsgBox "ルビを振りたい範囲をマウスで選択してから実行してください。", vbExclamation
        Exit Sub
    End If
    
    ' 確認メッセージの表示
    If MsgBox("選択した範囲の漢字に自動でルビを振ります。" & vbCrLf & _
              "よろしいですか?", _
              vbOKCancel + vbQuestion) = vbCancel Then
        Exit Sub
    End If

    ' Wordの画面更新を停止して処理を高速化
    Application.ScreenUpdating = False

    ' Excelアプリケーションオブジェクトを生成
    On Error Resume Next
    Set excelApp = CreateObject("Excel.Application")
    If excelApp Is Nothing Then
        MsgBox "Excelを起動できませんでした。処理を中断します。", vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    ' ★★★ 変更点 ★★★
    ' 処理対象を「選択範囲」に設定
    Set targetRange = Selection.Range
    totalWords = targetRange.words.Count
    
    ' ステータスバーに進捗を表示
    Application.StatusBar = "ルビ振り処理中... (0%)"

    ' 選択範囲内の「単語」ごとにループ
    For Each word In targetRange.words
        originalText = Trim(word.text)
        
        If HasKanji(originalText) Then
            reading = StrConv(excelApp.GetPhonetic(originalText), vbHiragana)
            
            lastKanjiIndex = 0
            For i = 1 To Len(originalText)
                If IsKanji(mid(originalText, i, 1)) Then
                    lastKanjiIndex = i
                End If
            Next i
            
            If lastKanjiIndex > 0 Then
                kanjiPart = Left(originalText, lastKanjiIndex)
                okuriganaPart = mid(originalText, lastKanjiIndex + 1)
                
                If Len(okuriganaPart) > 0 And Right(reading, Len(okuriganaPart)) = okuriganaPart Then
                    rubyText = Left(reading, Len(reading) - Len(okuriganaPart))
                Else
                    rubyText = reading
                End If
                
                Set kanjiRange = ActiveDocument.Range(start:=word.start, End:=word.start + Len(kanjiPart))
                
                If rubyText <> "" Then
                    kanjiRange.PhoneticGuide text:=rubyText, _
                                            Alignment:=wdPhoneticGuideAlignmentCenter, _
                                            Raise:=RubyOffset, _
                                            FontSize:=RubySize
                End If
            End If
        End If
        
        progress = progress + 1
        If totalWords > 0 Then
            Application.StatusBar = "ルビ振り処理中... (" & Format(progress / totalWords, "0%") & ")"
        End If
    Next word

    ' 後処理
    If Not excelApp Is Nothing Then
        excelApp.Quit
        Set excelApp = Nothing
    End If
    
    Application.ScreenUpdating = True
    Application.StatusBar = ""
    
    MsgBox "選択範囲のルビ振り処理が完了しました。", vbInformation

End Sub

' 文字列に漢字が含まれているか判定する補助関数
Private Function HasKanji(ByVal text As String) As Boolean
    Dim i As Integer
    For i = 1 To Len(text)
        If IsKanji(mid(text, i, 1)) Then
            HasKanji = True
            Exit Function
        End If
    Next i
    HasKanji = False
End Function

' 1文字が漢字かどうかを判定する補助関数
Private Function IsKanji(ByVal char As String) As Boolean
    IsKanji = (char Like "[一-龠々]")
End Function

以上で初期設定は終了です。

4 実際にルビを振る(たったの2ステップ)

1 ルビを打ちたい文章を選択し、 タブの『表示』から『マクロ』を選択

2 Auto rubyForSelection_Finalを選び、実行を選択。

3  ルビ振り完了✅

こちらの方法のよさは、なんといっても「速さ」と「手軽さ」です。ただし所々ルビに間違いがあるため、目視で見直しをして修正をして下さい。

なお,ルビ振りの結果はPCの環境(WordやExcelのバージョン,ATOKやIMEの学習環境等)によって変わります。安定性を求める場合は,以前紹介した方法をご利用ください。

今回の紹介は以上です。
この方法を考えてくれたワーママ先生にも感謝です(^ω^)

この他にも、ホームページ『前ネコ教育ツール研究室』では、教育現場で便利なツールを多数公開中!こちらも是非ご覧ください😊

R7.8.24 前ネコ先生


いいなと思ったら応援しよう!