【Word VBA】特定の色の蛍光ペンを消すWordマクロ

また、蛍光ペンの話題に戻ります。

先日の、「特定の色の蛍光ペンを検索することはできるのか？」でWordの基本機能では特定の蛍光ペンを探すことができないことを紹介いたしました。

そして、「蛍光ペンの色を判定する」の記事で、選択範囲の蛍光ペンの種類を判定するマクロを紹介いたしました。

今回は、さらに掘り下げて、特定の蛍光ペンを消す（解除する）マクロを紹介します。

このマクロでできることと想定している用途

指定した蛍光ペンの色だけを解除します。

蛍光ペンの色の判別の処理が泥臭いので、処理時間がかかる場合がありますのでご注意ください。

数百ページにおよぶ文章で、様々な蛍光ペンが混在している場合、数分かかる場合もあります。

こうすることで、原稿作成段階から、完成段階への移行が比較的スムーズになると思いますし、この機能を使って、仕事の進め方を少し工夫することができるかもしれません。

お試しください。

マクロの解説

31行目、37行目で、削除対象の色を指定しています。

以下の色を指定できます。（VBEのヘルプからの抜粋）

wdAuto 自動設定。通常の既定値は黒です。
wdBlack 黒
wdBlue 青
wdBrightGreen 明るい緑
wdByAuthor 文書の作成者が定義した色
wdDarkBlue 濃い青
wdDarkRed 濃い赤
wdDarkYellow 濃い黄
wdGray25 網かけ 25 の灰色
wdGray50 網かけ 50 の灰色
wdGreen 緑
wdNoHighlight 適用されている強調表示を解除します。
wdPink ピンク
wdRed 赤
wdTeal 青緑
wdTurquoise 水色
wdViolet 紫
wdWhite 白
wdYellow 黄

33行目は、前回の記事で紹介した混合の場合を示しています。

9999999と同じ意味ですが、wdUndefinedと示すことができます。

読者の方から教えていただきました。

より可読性が高まりました。ご教示をどうもありがとうございました。

マクロ


Sub 黄色蛍光ペンを消す_ループ処理()

　　Dim myRange As Range
　　Dim myEnd As Long

　　Set myRange = Selection.Range
　　Application.ScreenUpdating = False　'表示の更新をしない
　　ActiveDocument.Range(0, 0).Select

　　Selection.Find.ClearFormatting
　　Selection.Find.Replacement.ClearFormatting
　　With Selection.Find
　　　　.Text = ""
　　　　.Replacement.Text = ""
　　　　.Forward = True
　　　　.Wrap = wdFindContinue
　　　　.Format = False
　　　　.Highlight = True
　　　　.MatchCase = False
　　　　.MatchWholeWord = False
　　　　.MatchByte = False
　　　　.MatchAllWordForms = False
　　　　.MatchSoundsLike = False
　　　　.MatchWildcards = False
　　　　.MatchFuzzy = False
　　End With
　　Selection.Find.Execute

　　Do While Selection.Find.Found = True
　　　　Select Case Selection.Range.HighlightColorIndex
　　　　　　Case wdYellow
　　　　　　　　Selection.Range.HighlightColorIndex = wdNoHighlight
　　　　　　Case wdUndefined
　　　　　　　　myEnd = Selection.End
　　　　　　　　Do
　　　　　　　　　　Selection.End = Selection.Start + 1
　　　　　　　　　　If Selection.Range.HighlightColorIndex = wdYellow Then
　　　　　　　　　　　　Selection.Range.HighlightColorIndex = wdNoHighlight
　　　　　　　　　　End If
　　　　　　　　　　Selection.Collapse Direction:=wdCollapseEnd
　　　　　　　　Loop Until Selection.End = myEnd
　　　　End Select
　　　　Selection.Collapse Direction:=wdCollapseEnd
　　　　Selection.Find.Execute
　　Loop
　　myRange.Select
　　Set myRange = Nothing
　　Application.ScreenUpdating = True　'表示の更新をする
End Sub

特定の色の蛍光ペンを検索することはできるのか？

このマクロでできることと想定している用途

マクロの解説

マクロ

関連記事