【コード】特定の色の蛍光ペンを消す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

関連記事

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

蛍光ペンの色を判定する

蛍光ペンの目次

マクロコードの登録方法

ツールバーのボタン登録

トップへ戻る