Word VBA 数字をコンマ付き数字に変えるマクロ

公式サイトの教えるところ

Word で数字にコンマを入れる方法が知りたい -answers.microsoft.com
では【 文書内の数字を一括してカンマ(3桁区切り)を設定するには 】office-qa.com が紹介されている。
この問題は古くからあり、
半角数字に3桁区切りカンマを一括挿入する−([0-9]{1,3})([0-9]{3,3})・\1,\2
でも同様のことが紹介されている。
まず文末にジャンプして
変換を起動し、ワイルドカードを有効にして
([0-9]{1,3})([0-9]{3,3})
変換後
\1,\2
Note 日本語版のWordはバックスラッシュは円マークで表示される。
でこれを繰り返すというもの。

InsertComma

Sub InsertComma()
'For Word VBA
Application.DisplayAlerts = wdAlertsNone
Selection.EndKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9]{3})([0-9]{1,3})"
.Replacement.Text = "\1,\2"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Application.DisplayAlerts = wdAlertsAll

End Sub

これは繰り返し変換を4回かけるので15桁までの数字に対応している。
もっともこの方法は欠点があって、小数点以下の数字が長い場合でも変換してしまう。
0.1234564 > 0.1234,564 しかも入り方もこんな感じでおかしい。しかし、コンマ以下3桁までならこれもかなり有効ではある。

新田氏のマクロ

この問題はWord　MVPの新田氏が取り組んでおり、
新田氏は2011に
みんなのワードマクロ 3桁ごとにコンマを入れるマクロ amebloを発表し、2015年にみんなのワードマクロ 3桁ごとにコンマを入れるマクロ(1) wordvbalab.comを発表されている。ちなみにFormatを使う(2)は文字書式が保持されないので興味がある人は参照してください。
　通常はあとから発表されたものの方がよさそうな気もするが、Amebloの方が実務的である。
　ほかにも2005年にKenken_Sp氏がWordで桁を区切るマクロを作りたいoshiete.goo.ne.jpで発表されているが、ここでこのマクロが年がつく場合の問題に触れている。
　新田氏の2011のコードはこれを意識して年は区切らないようにしている。
しかし年以外にも法律がそうだ。また数式も場合によっては区切らない方が良いし区切った方が良い時もある。
　そこで除外文字を関数化してみた。

実験のために用意した文字列

1225465
1235565656565563
3455666条

12365654.
32+1234.12312324+6
123123年

コンマの全消し

実験のためにはもとに戻すマクロが必要だ

EraseComma

Sub EraseComma()
  Application.DisplayAlerts = wdAlertsNone

  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
    .Text = ","
    .Replacement.Text = ""
    .Forward = False
    .Wrap = wdFindAsk
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .CorrectHangulEndings = False
    .HanjaPhoneticHangul = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
  Application.DisplayAlerts = wdAlertsAll
  Application.ScreenRefresh
End Sub

関数化したもの

こちらが関数化したもので、数式も除外する。と言っても+,×,=,÷程度で-は減算も符号の場合もあるので難しい。
また数式の中でもコンマがいるよ、という人は下記の２つの関数の+,×,=,÷を除外してください。

NumberInsertComma

Sub NumberInsertComma()
   'For Word VBA
    Const cnsFind As String = "([0-9]{1,3})([0-9]{3})"
    Const cnsConv As String = "\1,\2"
    Dim wDoc As Word.Document: Set wDoc = ActiveDocument
    Dim wdRng As Word.Range
    Dim myLen As Integer

    '文書の末尾にRangeオブジェクトを設定
    With wDoc
        Set wdRng = .Range(.Range.End - 1, .Range.End - 1)
    End With

    '文書の末尾から先頭に向けてワイルドカードで4桁以上の数字を検索するというRange.Findの設定
    With wdRng.Find
        .Text = cnsFind
        .Replacement.Text = cnsConv
        .Forward = False
        .Wrap = wdFindStop
        .MatchWildcards = True
    End With

    '4桁以上の数字が見つかったときの処理
    With wdRng
        Do While .Find.Execute = True
            '数字が文頭の場合
            If .Start = 0 Then
                If wdFnNextText(.Next.Text) = False Then
                    myLen = Len(wdRng)
                    .Find.Execute Replace:=wdReplaceOne
                    .SetRange .End + myLen, .End + myLen
                End If
            '数字が文頭以外の場合
            Else
            Debug.Print .Text
            Debug.Print "Privious", .Previous.Text
                If wdFnPrevText(.Previous.Text) = True And wdFnNextText(.Next.Text) = False Then
                    myLen = Len(wdRng)
                    .Find.Execute Replace:=wdReplaceOne
                    .SetRange .End + myLen, .End + myLen
                End If
            End If
        Loop
    End With
    Set wdRng = Nothing 'Rangeオブジェクトの解放
End Sub

Function wdFnPrevText(str As String) As Boolean
Dim ar
Dim i As Long
ar = Split("第,+,×,=,÷,年,.", ",")
For i = LBound(ar) To UBound(ar)
If str = ar(i) Then wdFnPrevText = False: Exit Function
Next i
wdFnPrevText = True
End Function
Function wdFnNextText(str As String) As Boolean
Dim ar
Dim i As Long
ar = Split("年,号,項,条,+,×,=,÷", ",")
For i = LBound(ar) To UBound(ar)
If str = ar(i) Then wdFnNextText = True: Exit Function
Next i
wdFnNextText = False
End Function

稼働させた結果

1,225,465
1,235,565,656,565,563
3455666条

12,365,654.
32+1234.12312324+6
123123年

一応うまくいくようです。しかし設定が難しいよという方はInsertComma()を使ってください。
小数点以下もコンマが付きますが、動作原理が単純で安定しているのが良いです。