アラビア数字を漢数字に変換(VB6.0) - VBレスキュー(花ちゃん)

　下記プログラムコードに関する補足・注意事項　
動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6)
Option　：[Option Explicit]
参照設定：Microsoft Excel *.* ObjectLibrary / Microsoft Scripting Runtime　参照設定方法参照
使用 API：なし
その他　：
　　　　：

１．アラビア数字←→漢数字に変換する（数字のみ半角・全角変換もOK）

Option Explicit　　　'SampleNo:006　　2002.04.17　　 ① 2006.12.28

Private Function fKansujToArabia(ByVal MyString As String, _
　　　　　　　　　　　　　　　　ByVal ChangeNo As Long) As String
　　Dim Table(1 To 3) As String
　　Dim Icount　　　　As Long
　　Dim Location　　　As Long
　　Dim strTemp　　　 As String
　　strTemp = MyString
　　Table(1) = "0123456789-0123456789-〇一二三四五六七八九ー"
　　Table(2) = "0123456789-"
　　Table(3) = "〇一二三四五六七八九ー"
　　For Icount = 1 To Len(strTemp)
　　　　Location = InStr(Table(1), Mid$(strTemp, Icount, 1))
　　　　If Location Then
　　　　　　Select Case ChangeNo
　　　　　　　　Case 4　　　　　'半角だけ全角に(漢数字除く)
　　　　　　　　　　If Location <= 12 Then
　　　　　　　　　　　　Mid$(strTemp, Icount, 1) = Mid$(Table(2), Location, 1)
　　　　　　　　　　End If
　　　　　　　　Case 5　　　　　'全角だけ半角に(漢数字除く)
　　　　　　　　　　If Location >= 12 And Location <= 22 Then
　　　　　　　　　　　　Location = Location - 11
　　　　　　　　　　　　Mid$(strTemp, Icount, 1) = Mid$(Table(1), Location, 1)
　　　　　　　　　　End If
　　　　　　　　Case 1 To 3　　 '1=全半角　2=全全角　3=全漢数字
　　　　　　　　　　If Location >= 12 Then Location = Location - 11
　　　　　　　　　　If Location >= 12 Then Location = Location - 11
　　　　　　　　　　If Location >= 1 Then
　　　　　　　　　　　　Mid$(strTemp, Icount, 1) = _
　　　　　　　　　　　　　　　　　　Mid$(Table(ChangeNo), Location, 1)
　　　　　　　　　　End If
　　　　　　End Select
　　　　End If
　　Next Icount
　　fKansujToArabia = strTemp
End Function

Private Sub Command1_Click()
　　On Error Resume Next
　　Dim SelectNo As Long
　　'文字列の入力チェック
　　If Len(Trim$(Text1.Text)) = 0 Then
　　　　Beep
　　　　Exit Sub
　　End If
　　'長整数型に変換する
　　SelectNo = CLng(Text3.Text)
　　If Err.Number Then Beep: Exit Sub
　　Text2.Text = fKansujToArabia(Text1.Text, SelectNo)
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
　　' 1~5の範囲の入力制限
　　If KeyAscii >= 32 And KeyAscii < 49 Or KeyAscii > 53 Then
　　　　Beep　　　　　　　　　　 'エラー音
　　　　KeyAscii = 0　　　　　　 '入力キーを無効にする
　　End If
End Sub

　図１．上記実行結果
　

２．数字を色んな漢数字に変換する（１２３４→壱阡弐百参拾四　他）

こちらは、Excel の機能を利用していますので、VB から Excel が操作できる事が条件となります。

Private Function fKansuji(ByVal lngArabicNumerals As Long, _
　　　　　　　　　　　　　ByVal lngSelectNo As Long) As String
　　On Error Resume Next
　　Dim xlApp　 As Excel.Application
　　Dim xlBook　As Excel.Workbook
　　Dim xlSheet As Excel.Worksheet
　　'Set xlApp = New Excel.Application
　　'こちらでも可(どちらがいいかは解かりません)
　　Set xlApp = CreateObject("Excel.Application")
　　Set xlBook = xlApp.Workbooks.Add
　　Set xlSheet = xlBook.Worksheets.Add
　　'セル(A1)に数値を挿入
　　xlSheet.Cells(1, 1).Value = lngArabicNumerals
　　'Formula プロパティを使ってセルに式を挿入します。
　　Select Case lngSelectNo
　　　　Case 1　　　'千二百三十四に変換
　　　　xlSheet.Cells(1, 2).Formula = "=NUMBERSTRING(A1,1)"
　　　　Case 2　　　'壱阡弐百参拾四に変換
　　　　xlSheet.Cells(1, 2).Formula = "=NUMBERSTRING(A1,2)"
　　　　Case 3　　　'一二三四に変換
　　　　xlSheet.Cells(1, 2).Formula = "=NUMBERSTRING(A1,3)"
　　End Select
　　'変換結果を渡す
　　fKansuji = xlSheet.Cells(1, 2)
　　'保存時のダイログボックスを非表示に設定
　　xlApp.DisplayAlerts = False
　 'オブジェクトを解放します
　 Set xlSheet = Nothing
　 xlBook.Close　　　　　　'Book を閉じる
　 Set xlBook = Nothing
　 xlApp.Quit　　　　　　　'Quit メソッドを使って Excel を終了します。
　 Set xlApp = Nothing
End Function

Private Sub Command2_Click()
　　On Error Resume Next
　　Dim lngNumber As Long
　　Dim SelectNo　As Long
　　'長整数型に変換する
　　lngNumber = CLng(Text4.Text)
　　SelectNo = CLng(Text6.Text)
　　'文字が混じっていたら
　　If Err.Number Then Beep: Exit Sub
　　Text5.Text = fKansuji(lngNumber, SelectNo)
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
　　If KeyAscii >= 32 And KeyAscii < 48 Or KeyAscii > 57 Then
　　　　Beep　　　　　　　　　　 'エラー音
　　　　KeyAscii = 0　　　　　　 '入力キーを無効にする
　　End If
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
　　' 1~3の範囲の入力制限
　　If KeyAscii >= 32 And KeyAscii < 49 Or KeyAscii > 51 Then
　　　　Beep　　　　　　　　　　 'エラー音
　　　　KeyAscii = 0　　　　　　 '入力キーを無効にする
　　End If
End Sub

実行結果とコントロール類の貼り付け位置等は、図１．を参照して下さい。

処理としては数字(数値)だけを取り出し、エクセルの NUMBERSTRING 関数を使って漢数字に変換しているだけです。
NUMBERSTRING 関数はエクセルの隠し関数でヘルプにも載っていませんのであまり知られていないと思います。
最初の1回は少し時間がかかりますが次からは1秒以内で変換できるので使用には耐えられるかと思います。
これをVBだけでやろうとすると相当複雑になるかと思います。
使用例は簡略化していますので、実際はエラーチェック等を十分にして下さい。

検索キーワード及びサンプルコードの別名(機能名)

文字列中の数字だけを全部半角に変換　　文字列中の数字だけを全部全角に変換　　文字列中の数字だけを全部漢数字に変換　　文字列中の半角数字だけを全角に変換
文字列中の全角数字だけを半角に変換　　数字を千二百三十四のように変換（Excelの関数を使って）　　数字を壱千弐百参拾四のように変換（Excelの関数を使って）
数字を一二三四のように変換（Excelの関数を使って）

VBレスキュー(花ちゃん)

Visual Basic 6.0