Word：算用数字⇒漢数字変換マクロ のマクロをVBSに置き換えたものです
Function NumToKanji(para)
'------------------------------------------------------------------------
' 2015/08/08 VBS 版 に置き換え
' オリジナルは下記作成者
'------------------------------------------------------------------------
'テキストの英数字を漢数字に変換（半角0-9、全角０-９いずれも可）
'作成者 洋々亭 2006-2010
' 2006/8/27 Ver0.1
' 2010/10/4 ver0.4 ロジック整理
'○呼び出すサブルーチン：
' ①conv2kan(skan, setketa)
' ※setketa:0(KETAMOJI)で桁文字（十百千）使用、1(NOKETA)で桁文字不使用
'------------------------------------------------------------------------
'
dim KETAMOJI
dim NOKETA
KETAMOJI = 0 ' 七千三十五
NOKETA = 1 ' 七○三五
Dim flgketa
' flgketa設定：(漢数くん使用時は引数使用)
' 0(KETAMOJI)…千百十使う。／1(NOKETA)…千百十使わない
Dim str : str = ""
Dim piriunit
Dim strbuf :strbuf = ""
Dim pstr : pstr =""
Dim RE , RE2 , Matches, Match
' Dim myRange
Dim buf : buf =""
Set RE = CreateObject("VBScript.RegExp")
Set RE2 = CreateObject("VBScript.RegExp")
RE.Global = False 'True:全ての検索結果を処理、False:初出の結果のみ処理
RE2.Global = False
NumToKanji = ""
flgketa = 0 ' 0(KETAMOJI)…千百十使う
' ピリオド単位
piriunit = "(．|\.)"
' 途中でパラグラフを移動させないため、文字列bufにコピーして作業
buf = para
' 先に小数点[．|.]以下を変換（「三○五四」のようにベタ変換）
RE.Pattern = piriunit & "([0-9]+|[０１２３４５６７８９]+)"
Do
Set Matches = RE.Execute(buf)
If Matches.Count > 0 Then
str = conv2kan(Matches(0).SubMatches(1), NOKETA)
str = "・" & str
RE2.Pattern = Matches(0).Value
buf = RE2.Replace(buf, str)
End If
Loop Until Matches.Count = 0
'「NN,NNN,NNN,NNN ／ N,NNN億、N,NNN万」変換
RE.Pattern = "([0-9,]+|[０１２３４５６７８９，]+)"
Do
Set Matches = RE.Execute(buf)
If Matches.Count > 0 Then
strbuf = Replace(Matches(0).SubMatches(0), ",", "") 'カンマ削除
str = ""
If Len(strbuf) > 16 Then
pstr = Left(strbuf, Len(strbuf) - 16)
str = conv2kan(pstr, flgketa) & "京"
strbuf = Right(strbuf, 16)
End If
If Len(strbuf) > 12 Then
pstr = Left(strbuf, Len(strbuf) - 12)
str = conv2kan(pstr, flgketa) & "兆"
strbuf = Right(strbuf, 12)
End If
If Len(strbuf) > 8 Then
pstr = Left(strbuf, Len(strbuf) - 8)
str = str & conv2kan(pstr, flgketa) & "億"
strbuf = Right(strbuf, 8)
End If
If Len(strbuf) > 4 Then
pstr = Left(strbuf, Len(strbuf) - 4)
str = str & conv2kan(pstr, flgketa) & "万"
strbuf = Right(strbuf, 4)
End If
If Len(strbuf) > 0 Then
pstr = strbuf
str = str & conv2kan(pstr, flgketa)
End If
RE2.Pattern = Matches(0).Value
buf = RE2.Replace(buf, str)
End If
Loop Until Matches.Count = 0
' 作業bufが変更されていたら、paragraph置き換え
If buf <> para Then
para = buf
End If
Set RE = Nothing
Set Matches = Nothing
Set Match = Nothing
' Set myRange = Nothing
NumToKanji = para
End Function
Function conv2kan(ssan,setketa)
'------------------------------------------------------------------------
' 2015/08/08 VBS 版 に置き換え
' オリジナルは下記作成者
'---------------------------------------------------------------------
' conv2kan関数 ：英数字の文字列を漢数字の文字列に変換する。
' 作成者 洋々亭 2006-2010
' ○引数
' ssan ：処理する英数字（「0-9」,「０-９」どちらも可）
' setketa：1(KETAMOJI)で桁文字（十百千）使用、0(NOKETA)で桁文字不使用
' ○戻り値
' 変換結果の文字列
'---------------------------------------------------------------------
'
Const KETAMOJI = 0
Const NOKETA = 1
Const ALwpNUM = "０１２３４５６７８９，．"
Const ALpNUM = "0123456789,."
Const KANKETA2 = "一十百千" '桁漢字（一～千)
Const KANNUM = "一二三四五六七八九" '桁漢字あり用
Const KANopNUM = "〇一二三四五六七八九、・" '桁漢字無(ピリオド付き）
Dim sbuf , swork
Dim ileng
Dim iketa , pos , i , cnt
ileng = Len(ssan)
pos = ileng 'pos:漢字文字列中の処理中文字ポインタ
iketa = 1 '現在処理中の英数字の桁数
'全部半角に変換
swork = ""
pos = 0
For i = 1 To ileng
pos = InStr(ALwpNUM, Mid(ssan, i, 1))
If pos > 0 Then
swork = swork & Mid(ALpNUM, pos, 1)
Else
swork = swork & Mid(ssan, i, 1)
End If
Next
sbuf = ""
If setketa = NOKETA Then
'桁漢字を使わない表記の場合（例：一七〇五）
For i = 1 To ileng
cnt = InStr(ALpNUM, Mid(swork, i, 1))
sbuf = sbuf & Mid(KANopNUM, cnt, 1)
Next
conv2kan = sbuf
Exit Function
Else
'桁漢字を使った表記の場合 （例：千七百五）
swork = Replace(swork, ",", "") 'カンマ削除
iketa = 1 '現在処理中の英数字の桁数
ileng = Len(swork) '文字列長再取得
For i = ileng To 1 Step -1
cnt = CDbl(Mid(swork, i, 1))
If cnt = 1 Then
sbuf = Mid(KANKETA2, iketa, 1) & sbuf
ElseIf cnt >= 2 And cnt <= 9 Then
If iketa = 1 Then
sbuf = Mid(KANNUM, cnt, 1) & sbuf
Else
sbuf = Mid(KANKETA2, iketa, 1) & sbuf
sbuf = Mid(KANNUM, cnt, 1) & sbuf
End If
End If
iketa = iketa + 1
Next
End If
conv2kan = sbuf
Exit Function
End Function