' 本模块生成汉字大写的金额 '
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,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,Len(ST1) -
1
)
If
T1 <>
"0"
Then
s2 = CCh(Val(T1)) +
"佰"
+ s2
Else If
Left(s2,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,Len(ST1) -
1
) s3 = CCh(Val(T1)) + s3
End If If
ST1 <>
""
Then
T1 = Right(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,Len(ST1) -
1
)
If
T1 <>
"0"
Then
s3 = CCh(Val(T1)) +
"佰"
+ s3
Else If
Left(s3,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,
1
) +
" "
,
1
)) + Expda
Next
RMBChinese = IIf(Ntyp =
1
,
"负"
+ Expda,Expda)
End Function
(编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|