目次

1. 英単語集に含まれる語を赤文字にする

作成した英文の語注をつける際に、この単語って中学校で既習？と考えることが多いので、Wordファイル上で確認し、既習語彙を赤色にマークするマクロと語彙リスト(語形変化含)を作成しました。 (使用は自己責任でお願いします)

使用したデータセット https://www.pref.osaka.lg.jp/o180040/kotogakko/gakuji-g3/r07_kokosenbatsu.html

https://lexically.net/wordsmith/support/lemma_lists.html#gsc.tab=0　Yamasuma Someya's lemma list

使用手順

1. WordのVBAエディタを開く:

   • Alt + F11 を押してVBAエディタを開きます。
   • メニューから 挿入 > モジュール を選び、新しいモジュールを追加します。
   • 下記のコードをコピー＆ペーストします。

2. マクロを実行:

   • Alt + F8 を押して「マクロ」ダイアログを開きます。
   • HighlightWordsFromList を選択し、「実行」をクリックします。

3. 単語リストの選択:

   • ファイル選択ダイアログが表示されるので、単語リストの .csv ファイルを選択してください。(ファイルは↓の　語彙リスト.csv をダウンロードしてください)

     語彙リスト.csv

4. 結果確認:

   選択したリストに含まれる単語が、Word文書内で赤色に変更されます。

マクロ

Sub HighlightWordsFromCSV()
    Dim wordList As Object
    Dim wordFilePath As String
    Dim fileContent As String
    Dim wordArray() As String
    Dim doc As Document
    Dim rng As Range
    Dim i As Integer, j As Integer

    ' ファイル選択ダイアログを表示
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "語彙リスト(.csv)を選択してください"
        .Filters.Add "CSVファイル", "*.csv", 1
        .AllowMultiSelect = False
        If .Show <> -1 Then
            MsgBox "語彙リストが選択されませんでした。処理を終了します。", vbExclamation
            Exit Sub
        End If
        wordFilePath = .SelectedItems(1)
    End With

    ' 語彙リストを読み込む
    On Error Resume Next
    Set wordList = CreateObject("Scripting.FileSystemObject").OpenTextFile(wordFilePath, 1)
    If Err.Number <> 0 Then
        MsgBox "語彙リストを開けませんでした: " & wordFilePath, vbCritical
        Exit Sub
    End If
    fileContent = wordList.ReadAll
    wordList.Close
    On Error GoTo 0

    ' 語彙リストを配列に分割（改行ごとに分割）
    Dim lines() As String
    lines = Split(fileContent, vbCrLf)

    ' すべての列から単語を抽出して配列に格納
    Dim tempWords As Collection
    Set tempWords = New Collection
    For i = LBound(lines) To UBound(lines)
        If Trim(lines(i)) <> "" Then
            Dim columns() As String
            columns = Split(lines(i), ",") ' CSVをカンマで分割
            For j = LBound(columns) To UBound(columns)
                If Trim(columns(j)) <> "" Then
                    On Error Resume Next
                    tempWords.Add Trim(columns(j)), CStr(Trim(columns(j))) ' 重複を防ぐためキーを設定
                    On Error GoTo 0
                End If
            Next j
        End If
    Next i

    ' 配列に変換
    ReDim wordArray(1 To tempWords.Count)
    For i = 1 To tempWords.Count
        wordArray(i) = tempWords(i)
    Next i

    ' 現在のドキュメントを取得
    Set doc = ActiveDocument

    ' ドキュメント内の各単語を検索してハイライト
    For i = LBound(wordArray) To UBound(wordArray)
        If Trim(wordArray(i)) <> "" Then ' 空白をスキップ
            Set rng = doc.Content
            With rng.Find
                .Text = wordArray(i)
                .Replacement.Text = ""
                .Replacement.Font.Color = wdColorRed
                .Forward = True
                .Wrap = wdFindContinue
                .Format = True
                .MatchCase = False
                .MatchWholeWord = True
                .Execute Replace:=wdReplaceAll
            End With
        End If
    Next i

    MsgBox "処理が完了しました！", vbInformation
End Sub

2. 英単語集に含まれる語をレベル別に色分けする

CEFR-Jに対応して語彙を色分けできるようにしました。

使用したデータセット

https://www.pref.osaka.lg.jp/o180040/kotogakko/gakuji-g3/r07_kokosenbatsu.html