複数の用語を簡単に蛍光ペンでマーキングできると便利です。
そのためのアドイン（無料）が、用語のマーキングとコメントの挿入ソフト「蛍光と対策」です。
もちろん、Wordで動く翻訳チェックソフト「色deチェック」にも、同じ機能が搭載されています。
これらのアドインで使われているコード（プログラム）を紹介します。
＜目次＞
テキストファイルの保存形式
テキストファイルを保存するときには、デフォルトでShift JIS（ANSI）形式で保存されます。
日本語や英語を扱う場合にはこの形式で問題ないのですが、中国語やベトナム語など他の言語が記述されているときには文字化けの原因になります。
たとえば、ベトナム語が含まれるテキストファイルを設定を変更せずに保存しようとすると、以下のようなメッセージが表示されます。
このような場合には、以下のようにUnicode形式を選択して保存します。文字化けしません。
ところが、このようにUnicode形式で保存されたテキストファイルをVBAで読み込むには少し工夫が必要です。
一般的なVBAの記述（Openステートメントで開いて、Line Inputステートメントで1行ずつ読み込む）では、デフォルトの設定でShift JIS形式のファイルを読み込むことになっています。
なので、この方法を使うとUnicode形式のファイルでは文字化けしてしまうのです。
そこで、このような場合に対処するためのコードを紹介します。
このマクロでできること
Unicode形式で保存されたテキストファイルに列挙された用語を蛍光ペンで着色します。
このマクロは、Unicode形式のテキストファイル専用なので、Shift JIS形式のテキストファイルでは読み込んだ文字列が文字化けしてしまいます。
よって、逆にShift JIS形式のテキストファイルに列挙された用語は正確に着色されません。ご注意ください。
マクロの解説
FileSystemObjectオブジェクトとTextStreamオブジェクトを使います。
蛍光ペンで着色する箇所は、いつものRangeオブジェクトです。
［検索と置換］ダイアログボックスの機能を使っています。キーワードを検索し、置換後の文字列を空欄にして「蛍光ペンあり」の書式を設定して置換します。これでキーワードを着色できます。
17行目のmyFilePathには、適宜テキストファイルのパスを設定してください。
マクロ
Sub 蛍光ペンで着色_Unicodeテキストファイル()
Dim myDoc As Document '現在文書
Dim myRange As Range '検索用のRangeオブジェクト
Dim FSO As Object 'FileSystemObjectオブジェクト
Dim TSO As Object 'TextStreamオブジェクト
Dim myText As String 'マーキングする語句
Dim myFilePath As String '用語集のファイルパス
'-------------------------------------------
'設定
'-------------------------------------------
'現在の文書をmyDocに設定
Set myDoc = ActiveDocument
'テキストファイルのパスの設定
myFilePath = "C:\Users\OWNER\Documents\test.txt"
'蛍光ペンの色を黄色に設定
Options.DefaultHighlightColorIndex = wdYellow
'-------------------------------------------
'テキストファイルを開く
'-------------------------------------------
'読み取り専用で開く（IOMode:=1）
'ファイルがない場合に新規作成（Create:=True）
'Unicode形式で開く（Format:=-1）
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TSO = FSO.OpenTextFile(FileName:=myFilePath, _
IOMode:=1, _
Create:=True, _
Format:=-1)
'-------------------------------------------
'蛍光ペンでマーキング
'-------------------------------------------
With TSO
'ファイル末尾まで繰り返す
Do Until .AtEndOfStream
'1行分のデータ取り込み
myText = .ReadLine
If Len(myText) <> 0 Then
Set myRange = myDoc.Range(0, 0)
With myRange.Find
.Text = myText
.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 'すべてを置換する を実行
DoEvents
End With
End If
Loop
End With
'-------------------------------------------
'テキストファイルを閉じる
'-------------------------------------------
'ファイルを閉じる
TSO.Close
'-------------------------------------------
'後処理
'-------------------------------------------
'オブジェクト変数の解放
Set TSO = Nothing
Set FSO = Nothing
Set myRange = Nothing
End Sub
