昨日紹介したマクロ(【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 |