Wordで、カタカナと１桁数値を全角に、英字と２桁以上の数値を半角に変換するVBA

前回「英数字を半角にカタカナを全角に変換するExcel関数」という記事を書きました。

でも、このような機能は、長文でこそ威力を発揮します。そこで、Wordで同様の機能が得られるマクロを書いてみました。

マクロの使い方が分からない場合は、こちらの記事をご覧ください。Excelの例ですが、操作方法はWordもほぼ同じです。

では、マクロを示します。標準モジュールを挿入し、コピー&ペーストしてください。

'-----------------------------------------------------------------------
' Summary: 文書全体を全角変換し、英数は半角にする。１桁数値は選択する
'-----------------------------------------------------------------------
Public Sub CorrectTheCharacterWidth()
    Dim intAsc      As Integer          ' 文字コード
    Dim rng         As Range            ' 処理対象領域
    Dim strPattern  As String           ' マッチングパターン
    Dim vbRet       As VbMsgBoxResult   ' MsgBoxの戻り値保持用
    
    ' ─── 文書全体を全角に変換する ───
    ActiveDocument.Content.CharacterWidth = wdWidthFullWidth

    ' ─── 英字を半角にする ───
    ' 文書の先頭から検索する
    Set rng = ActiveDocument.Range(0, 0)
    With rng.Find
        ' 任意の１文字を処理対象にする
        .Text = "?"
        .MatchWildcards = True
        ' ワイルドカードがマッチする間はループする
        Do While .Execute
            ' 処理対象の１文字を半角にして、さらに文字コードにする
            intAsc = Asc(StrConv(rng.Text, vbNarrow))
            ' 文字が数字を除くAsciiコードなら半角変換対象
            If (intAsc >= &H20 And intAsc <= &H2F) Or _ (intAsc >= &H3A And intAsc <= &H7E) Then
                ' ワイルドカードがマッチした領域を半角に変換する
                rng.CharacterWidth = wdWidthHalfWidth
                ' 現在の処理対象領域の最後を次の検索開始位置にする
                rng.Collapse (wdCollapseEnd)
                ' 文書の最後で&H0Dにマッチする無限ループを避ける
                If rng.Start + 1 = rng.StoryLength Then Exit Do
            End If
        Loop
    End With

    ' ─── 数値を半角にする。１桁数値は選択する ───
    vbRet = MsgBox("１桁数値を全角にしますか？", _
            vbYesNo + vbQuestion, "１桁数値の全角/半角の選択")
    Select Case vbRet
        ' １桁を全角にするために１桁でない数をマッチングパターンにする
        Case vbYes: strPattern = "[０-９]{2,}"
        ' １桁も含めて半角にするために全ての数にマッチングさせる
        Case vbNo: strPattern = "[０-９]{1,}"
        Case Else: Exit Sub
    End Select
    ' 文書の先頭から検索する
    Set rng = ActiveDocument.Range(0, 0)
    ' ワイルドカードがマッチする間はループする
    With rng.Find
        .Text = strPattern
        .MatchWildcards = True
        Do While .Execute
            ' ワイルドカードがマッチした領域を全角に変換する
            rng.CharacterWidth = wdWidthHalfWidth
            ' 現在の処理対象領域の最後を次の検索開始位置にする
            rng.Collapse (wdCollapseEnd)
        Loop
    End With
    ' Rangeオブジェクトを解放する
    Set rng = Nothing
End Sub

長文の文書では、１桁の数値を全角で書いた方が見栄えがいいと思える場合があります。そこで、このマクロではメッセージボックスを表示して、１桁の数値を全角にするか半角にするかを選べるようにしました。

また、英字は、アスキーコードが特定の範囲に入ることで判断しています。丸カッコ、疑問符、感嘆符なども半角に変換されますので、ご注意ください。

本原稿もこのマクロで清書しました。１桁数値は全角にしました。英字を半角に変換する場合に１文字ずつ判断しているので、所要時間は約20秒でした。もう少し高速に動作させたいものです。でも、目視で確認するよりは高速ですし、見落としもありません。