たぶん全世界初

検索しても見つからないので。まあコンマじゃない国もあるし（ドイツが確か上）Publisher自体マイナーなので。

Word に続いて

Word VBA 数字をコンマ付き数字に変えるマクロ
が出来たので、これをPublsherに移植してみました。
いまのところ、単純な整数のみです。
というかここに来るまでが大変でしたけど。

Sub Insertcommas()
'For Publisher
'Microsoft VBScript Regular Expression 5.5 Laterを参照設定してください。

Dim pbDoc As Publisher.Document: Set pbDoc = ThisDocument
Dim pbPage As Publisher.Page, pbPages As Publisher.Pages
Dim shps As Publisher.Shapes, Shp As Publisher.Shape
Dim i As Long, i1 As Long, i2 As Long, iLength As Long
Dim tFrame As TextFrame, pbStories As Publisher.Stories, pbStory As Publisher.Story
Dim tRn1 As TextRange, tRng As Publisher.TextRange, tRn1sub As TextRange
Dim str As String
Set pbStories = pbDoc.Stories
For Each pbStory In pbStories
 If pbStory.HasTextFrame Then
  Set tFrame = pbStory.TextFrame
  Set tRng = tFrame.TextRange
  iLength = tRng.Length
  For i = iLength To 1 Step -1
     Set tRn1 = tRng.Characters(Start:=i, Length:=1)
      If IsNumericString(tRn1.Text) Then
         str = ""
         str = tRn1.Text
         For i1 = i - 1 To 1 Step -1
         Set tRn1sub = tRng.Characters(Start:=i1, Length:=1)
          If IsNumericString(tRn1sub.Text) Then
           str = tRn1sub.Text & str
           Else
             If Len(str) > 3 Then
             Call StringInsertcommma(i, iLength, i1, tRng, str)
             Exit For
             Else
             Exit For
             End If
          End If
         Next i1
       End If 'If IsNumericString(tRn1.Text) Then
  Next
 End If 'If pbStory.HasTextFrame Then
Next 'For Each pbStory In pbStories
End Sub
Sub StringInsertcommma(i As Long, iLength As Long, i1 As Long, tRng As TextRange, str As String)
Dim re As RegExp: Set re = New RegExp
Dim iDigi As Long
Dim tRna As TextRange
Dim tRNext As TextRange
Dim tRPrev As TextRange
Dim icommas As Long
Dim icnt As Long, icnt1 As Long
Dim buf As String
Dim rngFind As TextRange
Set tRna = tRng.Characters(Start:=i1 + 1, Length:=i - i1)
If tRna.Length <= 3 Then
icommas = 1
Else
  icommas = Int(tRna.Length / 3) - 1
  If tRna.Length Mod 3 <> 0 Then
  icommas = icommas + 1

  End If
End If
buf = ""
icnt1 = 1
For icnt = Len(str) To 1 Step -1
If icnt1 Mod 3 <> 0 Then
  buf = Mid(str, icnt, 1) & buf
Else
  buf = "," & Mid(str, icnt, 1) & buf
End If
icnt1 = icnt1 + 1
Next icnt
If Mid(buf, 1, 1) = "," Then buf = Replace(buf, ",", "", 1, 1, vbTextCompare)
With tRna.Find
.ReplaceScope = pbReplaceScopeOne
.FindText = str
.ReplaceWithText = buf
.Execute
End With


Set re = Nothing

End Sub
Function IsNumericString(str As String) As Boolean
Dim re As RegExp: Set re = New RegExp
With re
.Pattern = "[0-9]"
.Global = True
.IgnoreCase = False
.Multiline = False
If .Test(str) Then IsNumericString = True Else IsNumericString = False
End With
Set re = Nothing
End Function

ポイント

VBScript Regular Expression 5.5を参照設定してください。
ほぼすべてのテキストレンジを取得するにはActiveDocument.Storiesを使う。
この場合、全ページのテキストレンジを扱える。
各テキストレンジの最後から順にテキストレンジを動かして数字ではないところでいったん変換する。
変換文字列(コンマ入り数字)を作ってからReplaceする。中途半端にテキストレンジを動かすと例外処理でおかしくなる。
現在のところ半角数字のみ。年などの例外処理はない。（あとから追加する予定）
ワイルドカードがないのがWordと違う点。（参照設定をしないと正規表現が使えない）

確認されている問題

現在のところ1行目の1文字目から始まる数字が変換できません。なぜか2行目までテキストレンジが広がっていて、調べています。