英単語交じりの日本文で、英単語の前後に半角を入れるVBScript

Microsoft Wordにてレポートなどを書く際、日本語の文章に英単語が混じっている場合に、英単語（半角文字列）と日本文字（全角文字）との間に半角のスペースを入れる、というルールが存在するチームがあるようです。

そんな時は、Wordマクロとか、VBScriptとかを使って、楽に体裁を整えられると大分省力化できて、内容の方に集中できますよね。

一度、マクロを書いてから、 VBScript に書き直したものを作りましたのでご紹介します。

使い方は、メモ帳などを開いて、コードをコピー貼り付けして、[ファイル]-[名前を付けて保存]にて、
適当なファイル名+.vbs　を付けて、文字コードを UTF-16LE にして、[保存]します。

目的のWordファイルを開いておいてから、当VBScriptをダブルクリックして実行します。

• 半角文字のみの連続を検索して、左右の文字が半角スペースで無かったら半角スペースを挿入して行く。
• ただし、その一つ外側の文字やコードが改行だったり、日本語の句点だったり、半角のスペースを入れたくない文字だったら、半角スペースを挿入しない。

ということを素朴に実行するだけのスクリプトです。

カスタマイズ：

赤文字の部分は、半角スペース挿入前に行いたい処理や、終了後に行いたい処理をまとめて記述しています。必要に応じて削除したり、書き直したりしてご利用ください。

青文字の部分は、半角文字列の外側一つ左と一つ右の文字が、改行コードだったら（あるいは全角括弧だったら、句点だったら）半角スペースを入れない、というように例外処理を行うためのものです。よく使う文字が有ったら[ ]内に追記してご利用ください。

'*********************************
'Wordで書かれたレポートの体裁を整えるためのツールです。
'使い方は、目的のWordファイルを開いておいて、本ツールをダブルクリックします。
'念のため、Wordファイルは1つだけ開いて、あとのものは閉じておいた方が良いでしょう。
'
'  作:heijoutomate.info
'*********************************
' 半角英数字＋半角記号の単語の定義を正規表現風に指定。
Const h_word = "[ -~]{1,}"

'例外の設定（単語の外側の左右に、改行コードや全角の演算記号などがあったら、半角スペースを入れない。不要な場合は""内を削除）
Const chk_left = "[、（　），～\n\r×－−]"
Const chk_right = "[、（　），～\n\r×－−]"
'-----------------------------------------------
const wdStory=6
Const sp = " "
Const ins = " "
Const wdReplaceAll=2

on error resume next
Set objWord = GetObject(,"Word.Application")

if err.number<>0 then 
    WScript.Echo "対象のワードファイルが見つかりません。"
    WScript.Quit
end if
    on error goto 0
    Set objDoc = objWord.ActiveDocument
    set Selection = objWord.selection
    x = Msgbox(objDoc.name & chr(10)   & chr(10) & "についての操作を行います", vbYesNo, "確認")
    if x=vbNo then WScript.Quit

' 前段操作：半角スペースを挿入する前に、処理しておきたい置き換えなどの操作をここに記述
    x = MsgBox("丸括弧（）を一律で半角()に揃えますか？", vbYesNo, "確認")
    if x=vbYes then
        call character_change("（","(")
        call character_change("）",")")
    end if
 
    x = MsgBox("全角チルダ '〜' '～' を一律で'～'に揃えますか？", vbYesNo, "確認")
    if x=vbYes then
        call character_change("〜","～")
    end if
' 前段操作：ここまで。 
 
' 繰り返しの回数最大値を、文字数の10倍にしています。
    Selection.EndKey wdStory
    iend = Selection.End * 10
    st_old = 0

    Selection.HomeKey wdStory
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = h_word
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With

    For i = 1 To iend
        Selection.Find.Execute
        
        st = Selection.Start
        ed = Selection.End
        
        If st = ed Then Exit For
        
        If st < st_old Then Exit For
        tango = Selection.Text

        ch_left = Left(tango, 1)
        ch_right = Right(tango, 1)
        if st > 1 then
            ch_left2 = objDoc.Range(st - 1, st).Text
        else
            ch_left2 = chr(10)
        end if
        ch_right2 = objDoc.Range(ed, ed + 1).Text
        'Stop
        If Left(tango, 1) <> sp And Not (Pattern_matching(ch_left2, chk_left)) Then
            Selection.Start = st
            Selection.End = st
            Selection.TypeText ins
            st = st + 1
            ed = ed + 1
        End If
        If Right(tango, 1) <> sp And Not (Pattern_matching(ch_right2, chk_right)) Then
            Selection.Start = ed
            Selection.End = ed
            Selection.TypeText ins
            ed = ed + 1
        End If
        st_old = st
        Selection.Start = ed
    Next

' 後段操作：必要に応じて追加、削除してください。
    x = MsgBox(")の前のスペース、(の後のスペースを削除しますか？", vbYesNo, "確認")
    if x=vbYes then
        call character_change(" )",")")
        call character_change("( ","(")
    end if

    x = MsgBox("フォント「MS明朝」「TimesNewRoman」の調整をしますか？", vbYesNo, "確認")
    if x=vbYes then
        Selection.WholeStory
        Selection.Font.Name = "ＭＳ 明朝"
        Selection.Font.Name = "Times New Roman"
        Selection.End =Selection.Start
    end if

    x = MsgBox("11ポイントに揃えますか？", vbYesNo, "確認")
    if x=vbYes then
        Selection.WholeStory
        Selection.Font.Size = 11
        Selection.End =Selection.Start
    end if
'後段操作：ここまで。

msgbox("完了しました")
'End
'************************************************
Function Pattern_matching(moji, pat)
    Dim i
    Dim re
    Dim strIn
    Set re = New RegExp
    With re
            .Global = True          '文字列全体を検索
            .IgnoreCase = True      '大文字小文字を区別しない
            .Pattern = pat
            If .test(moji) Then
                Pattern_matching = True
            Else
                Pattern_matching = False
            End If
   End With

End Function

Sub character_change(be,af)
    const wdReplaceAll=2
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = be
        .Replacement.Text = af
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute , , , , , , , , , , wdReplaceAll
end sub