VB 金额大小写转换(两种方法)

' 本模块生成汉字大写的金额

'

Option Explicit

' 名称： CCh

' 得到一位数字 N1 的汉字大写

' 0 返回 ""

Function CCh(N1)
As String

Select Case N1

Case 0

CCh = "零"

Case 1

CCh = "壹"

Case 2

CCh = "贰"

Case 3

CCh = "叁"

Case 4

CCh = "肆"

Case 5

CCh = "伍"

Case 6

CCh = "陆"

Case 7

CCh = "柒"

Case 8

CCh = "捌"

Case 9

CCh = "玖"

End Select

End Function '()Function

'名称： ChMoney

' 得到数字 N1 的汉字大写

' 最大为 千万位

' O 返回 ""

Public Function ChMoney(N1)
As String

Dim tMoney As String

Dim lMoney As String

Dim tn '小数位置

Dim ST1
As String

Dim T1 As String

Dim s1 As String
'临时STRING 小数部分

Dim s2
As String '1000 以内

Dim s3
As String '10000

If N1 =
0 Then

ChMoney = " "

Exit Function

End If

If N1 < 0
Then

ChMoney = "负"
+ ChMoney(Abs(N1))

Exit Function

End If

tMoney = Trim(Str(N1))

tn = InStr(tMoney, ".")
'小数位置

s1 = ""

If tn <>
0 Then

ST1 = Right(tMoney, Len(tMoney) - tn)

If ST1 <>
"" Then

T1 = Left(ST1, 1)

ST1 = Right(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s1 = s1 + CCh(Val(T1)) + "角"

End If

If ST1 <> ""
Then

T1 = Left(ST1, 1)

s1 = s1 + CCh(Val(T1)) + "分"

End If

End If

ST1 = Left(tMoney, tn - 1)

Else

ST1 = tMoney

End If

s2 = ""

If ST1 <>
"" Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

s2 = CCh(Val(T1)) + s2

End If

If ST1 <> ""
Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s2 = CCh(Val(T1)) + "拾"
+ s2

Else

If Left(s2, 1) <>
"零" Then
s2 = "零" + s2

End If

End If

If ST1 <> ""
Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s2 = CCh(Val(T1)) + "佰"
+ s2

Else

If Left(s2, 1) <>
"零" Then
s2 = "零" + s2

End If

End If

If ST1 <> ""
Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s2 = CCh(Val(T1)) + "仟"
+ s2

Else

If Left(s2, 1) <>
"零" Then
s2 = "零" + s2

End If

End If

s3 = ""

If ST1 <>
"" Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

s3 = CCh(Val(T1)) + s3

End If

If ST1 <> ""
Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s3 = CCh(Val(T1)) + "拾"
+ s3

Else

If Left(s3, 1) <>
"零" Then
s3 = "零" + s3

End If

End If

If ST1 <> ""
Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s3 = CCh(Val(T1)) + "佰"
+ s3

Else

If Left(s3, 1) <>
"零" Then
s3 = "零" + s3

End If

End If

If ST1 <> ""
Then

T1 = Right(ST1, 1)

ST1 = Left(ST1, Len(ST1) - 1)

If T1 <>
"0" Then

s3 = CCh(Val(T1)) + "仟"
+ s3

End If

End If

If Right(s2, 1) =
"零" Then
s2 = Left(s2, Len(s2) - 1)

If Len(s3) >
0 Then

If Right(s3, 1) =
"零" Then
s3 = Left(s3, Len(s3) - 1)

s3 = s3 & "万"

End If

ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 &
"元整" & s1)

End Function

简单明了型

Function RMBChinese(ByVal
Rmb As Double)
As String

On Error Resume Next

Dim Rmbexp As String, Rmbda
As String, Expda
As String, Lent
As Integer, Ntyp
As Integer, Icnt
As Integer, i
As Integer, Trmb
As String

Rmb = Format(Rmb, "###0.00")

If Rmb >
999999999999.99 Then

RMBChinese = "需转换的金额整数长度超过了12位！"

Exit Function

End If

Rmbexp = "分角元拾佰仟万拾佰仟亿拾佰仟"

Rmbda = "零壹贰叁肆伍陆柒捌玖"

Ntyp = 0

Trmb = Replace(CStr(Format(Rmb,
"0.00")),
".", "")

If Left(Trmb,
1) =
"-" Then

Trmb = Mid(Trmb, 2)

Ntyp = 1

End If

Expda = ""

Icnt = Len(Trmb)

For i =
1 To Icnt

Expda = Mid(Rmbda, Val(Mid(Trmb, Icnt - i + 1,
1)) +
1, 1) + IIf(Mid(Rmbexp, i,
1) =
"元", Mid(Rmbexp, i,
1) +
" ", Mid(Rmbexp, i,
1)) + Expda

Next

RMBChinese = IIf(Ntyp = 1,
"负" + Expda, Expda)

End Function