文字装飾 MODIFICA

一定の記号で囲んだ文字列に文字色と蛍光ペンを加えます。逆に、文字色と蛍光ペンのある文字列を一定の記号で囲みます。Wordの言語資料では文字装飾が可能ですが、一般のテキストファイルでは文字記号だけが使われるので、両者間のデータ変換のためにこれを使用します。

上で「記号」の例として{{*}}としましたが、<H_*_H>のような指定も可能です。蛍光ペインの色はWordの「ホーム」→「フォント」グループ→「蛍光ペンの色」で指定してください。これが「色なし」で指定されていると、蛍光ペンのチェックがあっても蛍光ペンがつきません。

記号	括弧類などを使ってアステリスク(*)を囲みます。
文字色	プルダウンから文字色を選択します。
蛍光ペン	Wordの蛍光ペンを選択します。
記号から装飾へ	記号で囲んだ文字列に文字色と蛍光ペンを加えます。
装飾から記号へ	文字色と蛍光ペンのある文字列を一定の記号で囲みます。
新文書	新文書に出力します。
実行	選択したオプションを実行します。

データ例

一定の記号で囲んだ文字列に{{文字色}}と{{蛍光ペン}}を加えます。逆に、文字色と蛍光ペンのある文字列を一定の記号で囲みます。

記号から装飾へ

一定の記号で囲んだ文字列に文字色と蛍光ペンを加えます。逆に、文字色と蛍光ペンのある文字列を一定の記号で囲みます。

装飾から記号へ

一定の記号で囲んだ文字列に{{文字色}}と{{蛍光ペン}}を加えます。逆に、文字色と蛍光ペンのある文字列を一定の記号で囲みます。

コントロール

オブジェクト名	キャプション/値
lbl記号	記号
txt記号	{*}
lbl文字色	文字色
cbo文字色	赤
chk蛍光ペン	蛍光ペン（チェックあり）
opt記号から装飾へ	記号から装飾へ
opt装飾から記号へ	装飾から記号へ
chk新文書	新文書
cmd実行	◎実行

コード

Option Explicit '変数を明示

Dim obj連想配列 As Object, obj正規表現 As Object

Private Sub UserForm_Activate() 'ユーザーフォーム表示

Set obj連想配列 = CreateObject("Scripting.Dictionary")

'連想配列オブジェクト生成

Set obj正規表現 = CreateObject("VBScript.RegExp")

'正規表現オブジェクト生成

obj正規表現.Global = True '全体検索

'コンボボックス準備：連想配列準備

cbo文字色.AddItem "赤": obj連想配列("赤") = wdRed

cbo文字色.AddItem "緑": obj連想配列("緑") = wdGreen

cbo文字色.AddItem "青": obj連想配列("青") = wdBlue

cbo文字色.AddItem "黒": obj連想配列("黒") = wdBlack

cbo文字色.AddItem "灰": obj連想配列("灰") = wdGray50

cbo文字色.AddItem "白": obj連想配列("白") = wdWhite

cbo文字色.ListIndex = 0 '最初の項目を選択

End Sub

コンボボックスのアイテムを追加し、同時に連想配列に色名をキーにして色指定のWord定数をアイテムに代入します。

Private Sub cmd実行_Click()

If Len(Selection) = 0 Then MsgBox "範囲を選択してください。": Exit Sub

If chk新文書 Then Call 新文書

If opt記号から装飾へ Then Call 記号から装飾へ

If opt装飾から記号へ Then Call 装飾から記号へ

End Sub

選択範囲を確認し、新文書が選択されていれば新文書にコピーします。以下2つのオプションに従います。

Private Sub UserForm_QueryClose(Cancel%, CloseMode%) '×終了ボタン

Set obj連想配列 = Nothing '連想配列オブジェクトを解放

Set obj正規表現 = Nothing '正規表現オブジェクトを解放

End '終了

End Sub

Private Sub 記号から装飾へ()

Dim 検索文字$

With Selection.Find '選択範囲検索

検索文字$ = 正規表現置換$(txt記号, "([{}()<>\[\]])", "\$1")

'括弧類エスケープ({*} > \{*\})

検索文字$ = Replace(検索文字$, "*", "(*)") '* > (*)

.ClearFormatting '検索初期化

.Text = 検索文字$ '\{(*)\}

With .Replacement '置換

.ClearFormatting '置換初期化

.Text = "\1" '置換文字 \1：(*)の一致文字列

.Font.ColorIndex = obj連想配列(cbo文字色.Value) '置換文字色

.Highlight = chk蛍光ペン '置換蛍光ペン：指定

End With

.MatchWholeWord = False '単語の一部も検索

.MatchByte = False '全角半角文字を区別しない

.MatchPhrase = False '単語間の空白文字を無視しない

.MatchSoundsLike = False '類似単語検索をしない

.MatchFuzzy = False '曖昧検索をしない

.MatchAllWordForms = False '活用形検索（～）

.MatchWildcards = True 'ワイルドカード置換

.Wrap = wdFindStop '末尾で検索終了

.Execute Replace:=wdReplaceAll '全置換

End With

End Sub

検索文字に使う括弧類（{}()<>[]）は、ワイルドカードで特定の機能をもつのでエスケープします。ワイルドカードによる置換では(*)にマッチした文字列は\1で再生されます。ここのテキストボックスでは*だけで指定してあるので、これを(*)に置換します。選択範囲検索の検索文字は、この例では{*}が\{(*)\}に置換されています。置換文字を\1とし、置換文字色はobj連想配列に格納したWord色指定定数をコンボボックスの値をキーにして取得し、これを代入します。蛍光ペンはchk蛍光ペンのブール値(True/False)を代入します。ワイルドカードを使用し、末尾で検索を終了します。

Private Sub 装飾から記号へ()

With Selection.Find '選択範囲検索

.ClearFormatting '検索を初期化

.Replacement.ClearFormatting '置換を初期化

.Text = "" '検索文字：なし

.Font.ColorIndex = obj連想配列(cbo文字色.Value) '検索文字色

.Highlight = chk蛍光ペン '検索蛍光ペン：指定

With .Replacement '置換

.Text = Replace(txt記号, "*", "^&") '置換文字：{全体一致} {^&}

.Font.ColorIndex = obj連想配列("黒") '置換文字色

.Highlight = False '置換蛍光ペン：なし

End With

.MatchWholeWord = False '単語の一部も検索

.MatchByte = False '全角半角文字を区別しない

.MatchPhrase = False '単語間の空白文字を無視しない

.MatchSoundsLike = False '類似単語検索をしない

.MatchFuzzy = False '曖昧検索をしない

.MatchAllWordForms = False '活用形検索（～）

.MatchWildcards = True 'ワイルドカード置換

.Wrap = wdFindStop '末尾で検索終了

.Execute Replace:=wdReplaceAll '全置換

End With

End Sub

文字を検索するのではなく、指定された文字色と蛍光ペンがついた文字を検索します。置換文字では^&で一致した文字全体を再生します。これに指定された記号（上の例では{}）で囲みます。VBAのReplace関数は{*}を{^&}に置換します。置換文字列の色は黒とし、蛍光ペンはつけません。

Private Function 正規表現置換$(ByVal 対象$, 検索$, 置換$)

obj正規表現.Pattern = 検索$ '検索パターン

正規表現置換$ = obj正規表現.Replace(対象$, 置換$) '置換

End Function

正規表現については→「準備」

2012/5/21 H. Ueda