【Word VBA】音声読み上げ機能の不具合を解消するWordマクロ

2022年3月9日

以前の記事「【Word】音声読み上げ機能の不具合の解消方法」で、段落先頭に全角記号を挿入してWordの音声読み上げ機能の不具合を解消するという裏技を紹介しました。

本記事では、この全角機能の挿入と削除を自動化するためのWordマクロを紹介します。

このマクロでできること

対象の文書の段落先頭に●を追加します。

(実行前)

(実行後)

また、別の削除用のマクロを使えば、音読後に挿入した記号を削除もできます。

マクロの解説

●を挿入するマクロと削除するマクロの2種類があります。

いずれのマクロにもUndoRecordオブジェクトを使用して[Ctrl]+[Z]のショートカットキーで1回で元に戻せるようにしています。

全角記号として挿入するのは●以外にもなんでもかまいません。文書で使われていない記号にしてください。

今回のマクロでは処理対象がわかりやすいので一括置換をしていますが、蛍光ペンでの着色はしていません。

記号や蛍光ペンの処理については好みに応じて修正して使ってみてください。

なお、段落先頭に文字列「●」を挿入する場合、「段落記号」+「●」として定義をして置換をします。

そのため、文書先頭への文字列の挿入が置換ではできないため、別途処理を追加しています。(挿入マクロ、削除マクロともに16行目)

マクロ(●挿入)


Sub 段落先頭に●を挿入するWordマクロ()

 '-------------------------------------------
 'UndoRecordの利用
 '-------------------------------------------
 #If VBA7 Then
  Dim objUndo As UndoRecord
  Set objUndo = Application.UndoRecord
  objUndo.StartCustomRecord ("●を挿入")
 #End If

 '-------------------------------------------
 '処理の実行
 '-------------------------------------------
 '文書先頭に●を挿入
 ActiveDocument.Range.InsertBefore "●"
 
 '文書全体の段落先頭に●を挿入
 Dim myRange As Range: Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = "^p"
  .Replacement.Text = "^p●"
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = False
  .Execute Replace:=wdReplaceAll
  DoEvents
 End With

 Set myRange = Nothing

 '-------------------------------------------
 'UndoRecordの利用
 '-------------------------------------------
 #If VBA7 Then
  objUndo.EndCustomRecord
  Set objUndo = Nothing
  Application.ScreenRefresh
 #End If
 
End Sub

マクロ(●削除)

Sub 段落先頭の●を削除するWordマクロ()

 '-------------------------------------------
 'UndoRecordの利用
 '-------------------------------------------
 #If VBA7 Then
  Dim objUndo As UndoRecord
  Set objUndo = Application.UndoRecord
  objUndo.StartCustomRecord ("●を削除")
 #End If

 '-------------------------------------------
 '処理の実行
 '-------------------------------------------
 '文書先頭の●を削除
 If ActiveDocument.Range.Characters.First = "●" Then
  ActiveDocument.Range.Characters.First.Delete
 End If
 
 '文書全体の段落先頭の●を削除
 Dim myRange As Range: Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = "^p●"
  .Replacement.Text = "^p"
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = False
  .Execute Replace:=wdReplaceAll
  DoEvents
 End With

 Set myRange = Nothing

 '-------------------------------------------
 'UndoRecordの利用
 '-------------------------------------------
 #If VBA7 Then
  objUndo.EndCustomRecord
  Set objUndo = Nothing
  Application.ScreenRefresh
 #End If
 
End Sub

関連記事

【Word】音声読み上げ機能の不具合の解消方法

-コード
-


即実践できる使い方のコツを紹介します

人気記事ランキング

1

「ワイルドカードの学び方:書ける前に読めるようにする」、「ワイルドカードを用いて第●章を検索する方法」、「ワイルドカードを用いて特許明細書の段落番号を検索する」に続く記事です。 これまでの記事で紹介し ...

2

「ワイルドカードの学び方:書ける前に読めるようにする」と「ワイルドカードを用いて第●章を検索する方法」に続く記事です。 この記事では、ワイルドカード検索の別の事例として特許明細書の段落番号を取り上げま ...

no image 3

クリップボードを用いた置換によるデメリット 「クリップボードを用いた置換(基礎編)」で紹介したクリップボードを用いた置換にもいくつかのデメリットがあります。活用するうえでは注意が必要です。本記事では以 ...