【Word VBA】書類の蛍光ペンをすべて解除するマクロ(2)

2016年5月7日

以前、「書類の蛍光ペンをすべて解除するマクロ 」という記事にて以下のマクロを紹介しました。


Sub No_HighLight()
 ActiveDocument.Range.HighlightColorIndex = wdNoHighlight
End Sub

ところが、このマクロでは蛍光ペンが解除できないパターンがあることが分かりました。

現在分かっているのは、以下のようなケースです。

・文書中で蛍光ペンで着色されている箇所が全角スペースと半角スペースのみ

16-05-071

この場合、上記のマクロではなぜか蛍光ペンが削除できません

しかし、スペース以外の文字列が1文字でも蛍光ペンで着色されている場合には、上記のマクロで蛍光ペンを解除できるのです。

16-05-072

そのようなわけで、上記マクロを改良してスペースのみが蛍光ペンで着色されている場合でも蛍光ペンを解除できるようなマクロを作成しました。

このマクロでできること

スペースのみが蛍光ペンで着色されている場合でも蛍光ペンを解除できます。

マクロの解説

かなり泥臭いマクロです。

文書においてスペース以外の文字列を探し、見つかった場合にその文字列を蛍光ペンで着色してから上記のNo_HighLightのマクロを実行するのです。

なので、文書の先頭から1文字ずつ文字を判定しています。For ... Next ステートメントを利用しました。(26行~31行)

なお、編集記号1文字については蛍光ペンで着色ができないため、全角・半角スペースに加え、5種類の編集記号も蛍光ペンを着色する対象から除外しています。

判定にInStr関数を用いました。(27行)

InStr 関数 - MSDN - Microsoft

マクロ


Sub 蛍光ペンを解除する()
 
 Dim myChr As Range
 Dim myDoc As Document
 Dim myExcludes As String
 
 Set myDoc = ActiveDocument
 
 '-------------------------------------------
 '蛍光ペンを着色する対象から除外する文字列
 '-------------------------------------------
 'Chr(9)  タブ
 'Chr(11) ソフトリターン(Shift + Enter)
 'Chr(12) 改ページ・セクション区切り
 'Chr(13) ハードリターン(Enter)
 'Chr(14) 段区切り
 'Chr(32) 半角スペース
 'Chr(-32448) 全角スペース
 
 myExcludes = Chr(9) & Chr(11) & Chr(12) & Chr(13) & _
        Chr(14) & Chr(32) & Chr(-32448)
 
 '-------------------------------------------
 '文書の先頭から除外文字列以外を探して蛍光ペンで着色
 '-------------------------------------------
 For Each myChr In myDoc.Characters
  If InStr(1, myExcludes, myChr) = 0 Then
   myChr.HighlightColorIndex = wdYellow
   Exit For
  End If
 Next
 
 '-------------------------------------------
 '蛍光ペン解除
 '-------------------------------------------
 myDoc.Range.HighlightColorIndex = wdNoHighlight
 
 Set myDoc = Nothing
 
End Sub

 

▼関連記事

書類の蛍光ペンをすべて解除するマクロ

InStr 関数 - MSDN - Microsoft

-コード
-,