【Word VBA】書式を蛍光ペンで着色するWordマクロ(その2)

2014年8月7日

昨日紹介したマクロ(【Wordマクロ】書式を蛍光ペンで着色する(その1))を改造しました。

複数の書式を別々の色で連続で着色してみます。

このマクロでできること

本文中の書式に以下のように蛍光ペンで着色します。

上付き:黄色
下付き:明るい緑
太字:水色
一重下線:ピンク

(実行前)

(実行後)

マクロの解説

昨日紹介したマクロをつなげました。

変数(myRange、myColor)の宣言は冒頭で一度するだけです。
蛍光ペンの色を書式ごとに設定して着色処理(置換処理)を実行します。

つなげると便利かも?と思ってやってみました。
プログラムが長くなりますが、つなげると一度に実行できて便利です。

マクロ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Sub 蛍光ペン_書式()
 
 Dim myRange As Range
 Dim myColor As String '蛍光ペンの色
 
 '-----------------------------------
 '蛍光ペンの色の設定(黄色)
 '-----------------------------------
 '現在選択されている蛍光ペンの色の保存
 myColor = Options.DefaultHighlightColorIndex
 
 '蛍光ペンの色を黄色に設定
 Options.DefaultHighlightColorIndex = wdYellow
 
 '-----------------------------------
 'Rangeオブジェクトの設定・置換
 '-----------------------------------
 Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = "" '検索する文字列
  .Font.Superscript = True '検索する文字列の書式:上付き
  .Replacement.Text = "" '置換後の文字列
  .Replacement.Highlight = True '置換後の文字列の蛍光ペン
  .Forward = True
  .Wrap = wdFindStop
  .Format = True       '書式:オン
  .MatchCase = False     '大文字と小文字の区別する
  .MatchWholeWord = False  '完全に一致する単語だけを検索する
  .MatchByte = False     '半角と全角を区別する
  .MatchAllWordForms = False '英単語の異なる活用形を検索する
  .MatchSoundsLike = False  'あいまい検索(英)
  .MatchFuzzy = False    'あいまい検索(日)
  .MatchWildcards = False  'ワイルドカードを使用する
  .Execute Replace:=wdReplaceAll 'すべてを置換する を実行
 End With
 
 '-----------------------------------
 '蛍光ペンの色の設定(明るい緑)
 '-----------------------------------
 Options.DefaultHighlightColorIndex = wdBrightGreen
 
 '-----------------------------------
 'Rangeオブジェクトの設定・置換
 '-----------------------------------
 Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = ""
  .Font.Subscript = True '検索する文字列の書式:下付き
  .Replacement.Text = ""
  .Replacement.Highlight = True '置換後の文字列の蛍光ペン
  .Forward = True
  .Wrap = wdFindStop
  .Format = True       '書式:オン
  .MatchCase = False     '大文字と小文字の区別する
  .MatchWholeWord = False  '完全に一致する単語だけを検索する
  .MatchByte = False     '半角と全角を区別する
  .MatchAllWordForms = False '英単語の異なる活用形を検索する
  .MatchSoundsLike = False  'あいまい検索(英)
  .MatchFuzzy = False    'あいまい検索(日)
  .MatchWildcards = False  'ワイルドカードを使用する
  .Execute Replace:=wdReplaceAll 'すべてを置換する を実行
 End With
 
 '-----------------------------------
 '蛍光ペンの色の設定(水色)
 '-----------------------------------
 Options.DefaultHighlightColorIndex = wdTurquoise
 
 '-----------------------------------
 'Rangeオブジェクトの設定・置換
 '-----------------------------------
 Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = ""
  .Font.Bold = True '検索する文字列の書式:太字
  .Replacement.Text = ""
  .Replacement.Highlight = True '置換後の文字列の蛍光ペン
  .Forward = True
  .Wrap = wdFindStop
  .Format = True       '書式:オン
  .MatchCase = False     '大文字と小文字の区別する
  .MatchWholeWord = False  '完全に一致する単語だけを検索する
  .MatchByte = False     '半角と全角を区別する
  .MatchAllWordForms = False '英単語の異なる活用形を検索する
  .MatchSoundsLike = False  'あいまい検索(英)
  .MatchFuzzy = False    'あいまい検索(日)
  .MatchWildcards = False  'ワイルドカードを使用する
  .Execute Replace:=wdReplaceAll 'すべてを置換する を実行
 End With
 
 '-----------------------------------
 '蛍光ペンの色の設定(ピンク)
 '-----------------------------------
 Options.DefaultHighlightColorIndex = wdPink
 
 '-----------------------------------
 'Rangeオブジェクトの設定・置換
 '-----------------------------------
 Set myRange = ActiveDocument.Range(0, 0)
 
 With myRange.Find
  .Text = ""
  .Font.Underline = wdUnderlineSingle '検索する文字列の書式:一重下線
  .Replacement.Text = ""
  .Replacement.Highlight = True '置換後の文字列の蛍光ペン
  .Forward = True
  .Wrap = wdFindStop
  .Format = True       '書式:オン
  .MatchCase = False     '大文字と小文字の区別する
  .MatchWholeWord = False  '完全に一致する単語だけを検索する
  .MatchByte = False     '半角と全角を区別する
  .MatchAllWordForms = False '英単語の異なる活用形を検索する
  .MatchSoundsLike = False  'あいまい検索(英)
  .MatchFuzzy = False    'あいまい検索(日)
  .MatchWildcards = False  'ワイルドカードを使用する
  .Execute Replace:=wdReplaceAll 'すべてを置換する を実行
 End With
 
 '-----------------------------------
 '蛍光ペンの色の再設定
 '-----------------------------------
 Options.DefaultHighlightColorIndex = myColor
 
 '-----------------------------------
 'Rangeオブジェクトの解放
 '-----------------------------------
 Set myRange = Nothing
 
End Sub

関連記事

【Wordマクロ】書式を蛍光ペンで着色する(その1)

-コード
-, ,

S