人民币金额转换例程

'调用方法Text2 = ChMoney(Val(Text1))
' 名称： CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private 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
'名称： ChMoney
' 得到数字 N1 的汉字大写
' 最大为 千万位
' O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
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
'调用方法Text2 = ChMoney(Val(Text1))
' 名称： CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private 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
'名称： ChMoney
' 得到数字 N1 的汉字大写
' 最大为 千万位
' O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有