复杂精确型

' 本模块生成汉字大写的金额
'
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) = t color="#808080">"-" 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


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!