ワードの文章に一括して漢字の上にルビ(ふりがな)をふるワードのマクロ youtubeshort

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

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

'文書全体にルビ設定
Public Sub すべてにふりがなをふる()
SetPhoneticRange ActiveDocument.Range, False
End Sub

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

'文書全体にルビ設定(最初の漢字のみ)
Public Sub すべてに最初の漢字のみふりがなをふる()
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

Sub ふりがなを削除する()

Dim myField As Field
Dim myRange As Range

'画面のちらつき防止
Application.ScreenUpdating = False

'カーソル位置の保存
Set myRange = Selection.Range

For Each myField In ActiveDocument.Fields
If myField.Type = wdFieldFormula Then
If InStr(1, myField.Code.Text, "\s\up") > 0 Then
myField.Select
Selection.Range.PhoneticGuide ""
End If
End If
Next

'カーソル位置を元に戻す
myRange.Select

'Rangeオブジェクトの解放
Set myRange = Nothing

Application.ScreenUpdating = True

End Sub
左が一括して漢字にふりがな(ルビ)をふる、福原将之さんの「科学カフェ」というサイトで紹介されているマクロです。このマクロをワードに一度入れれば、ずーっと使い続けることができます。 
① ワードの一番上のメニューの「表示」をクリックしてください。 
 
② 右端の方にある「マクロ」をクリックしてください。 
 
③ 「マクロの表示」を選択してください。 
 
④ 「ルビ」「ふりがな」など適当な名前をマクロ名のところに入力してください。
 
⑤ 「作成」ボタンを押してください。 
 
⑥ 下のような画面が出てくるので、Subから始まる赤い部分をすべて消してください。 
 
⑦ 左のマクロを、少し長いですが、すべて選択して、先ほど消したところにコピー、貼り付けしてください。 下のような画面になります。矢印の保存のところをクリックしてください。一番右上の×を押して終了です。
 
⑧ 再びメニューの「表示」→「マクロ」→「マクロの表示」を順にクリックしていくと、登録されたマクロが表示されます。いずれかを選択して「実行」ボタンを押してください。ワードの文章の漢字の上に一括してふりがながふられます。 
 
動画を大きく  
※パソコンによってスムーズにすべての漢字にルビがふられることもあるし、いくつかの漢字にルビがふられない場合があります。また、1つの漢字で動作が止まってしまうこともあります。その場合はEscキーを押して終了してください。ルビがふられない原因は元々対象文字列にルビがない場合なので、手作業でルビをふるようにしてください。 
※ルビが小さすぎて見えにくい、ルビを大きくしたい、という場合は、ルビの大きさを一括して変換する方法があります。こちらをご覧ください。 
ルビの大きさを一括して変える方法(PDFファイル)