' 本模块生成汉字大写的金额@H_301_3@ '@H_301_3@ Option Explicit@H_301_3@ ' 名称： CCh@H_301_3@ ' 得到一位数字 N1 的汉字大写@H_301_3@ ' 0 返回 ""@H_301_3@ Function CCh(N1) As String@H_301_3@ Select Case N1@H_301_3@ Case 0@H_301_3@ CCh = "零"@H_301_3@ Case 1@H_301_3@ CCh = "壹"@H_301_3@ Case 2@H_301_3@ CCh = "贰"@H_301_3@ Case 3@H_301_3@ CCh = "叁"@H_301_3@ Case 4@H_301_3@ CCh = "肆"@H_301_3@ Case 5@H_301_3@ CCh = "伍"@H_301_3@ Case 6@H_301_3@ CCh = "陆"@H_301_3@ Case 7@H_301_3@ CCh = "柒"@H_301_3@ Case 8@H_301_3@ CCh = "捌"@H_301_3@ Case 9@H_301_3@ CCh = "玖"@H_301_3@ End Select@H_301_3@ End Function '()Function@H_301_3@ @H_301_3@ '名称： ChMoney@H_301_3@ ' 得到数字 N1 的汉字大写@H_301_3@ ' 最大为 千万位@H_301_3@ ' O 返回 ""@H_301_3@ Public Function ChMoney(N1) As String@H_301_3@ Dim tMoney As String@H_301_3@ Dim lMoney As String@H_301_3@ Dim tn '小数位置@H_301_3@ Dim ST1 As String@H_301_3@ Dim T1 As String@H_301_3@ Dim s1 As String '临时STRING 小数部分@H_301_3@ Dim s2 As String '1000 以内@H_301_3@ Dim s3 As String '10000@H_301_3@ @H_301_3@ @H_301_3@ @H_301_3@ If N1 = 0 Then@H_301_3@ ChMoney = " "@H_301_3@ Exit Function@H_301_3@ End If@H_301_3@ If N1 < 0 Then@H_301_3@ ChMoney = "负" + ChMoney(Abs(N1))@H_301_3@ Exit Function@H_301_3@ End If@H_301_3@ tMoney = Trim(Str(N1))@H_301_3@ tn = InStr(tMoney, "." ) '小数位置@H_301_3@ s1 = ""@H_301_3@ If tn <> 0 Then@H_301_3@ ST1 = Right(tMoney,Len(tMoney) - tn)@H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Left(ST1, 1 )@H_301_3@ ST1 = Right(ST1,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s1 = s1 + CCh(Val(T1)) + "角"@H_301_3@ End If@H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Left(ST1, 1 )@H_301_3@ s1 = s1 + CCh(Val(T1)) + "分"@H_301_3@ End If@H_301_3@ End If@H_301_3@ ST1 = Left(tMoney,tn - 1 )@H_301_3@ Else@H_301_3@ ST1 = tMoney@H_301_3@ End If@H_301_3@ @H_301_3@ s2 = ""@H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Right(ST1, 1 )@H_301_3@ ST1 = Left(ST1,Len(ST1) - 1 )@H_301_3@ s2 = CCh(Val(T1)) + s2@H_301_3@ End If@H_301_3@ @H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Right(ST1,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s2 = CCh(Val(T1)) + "拾" + s2@H_301_3@ Else@H_301_3@ If Left(s2, 1 ) <> "零" Then s2 = "零" + s2@H_301_3@ End If@H_301_3@ End If@H_301_3@ @H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Right(ST1,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s2 = CCh(Val(T1)) + "佰" + s2@H_301_3@ Else@H_301_3@ If Left(s2,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s2 = CCh(Val(T1)) + "仟" + s2@H_301_3@ Else@H_301_3@ If Left(s2, 1 ) <> "零" Then s2 = "零" + s2@H_301_3@ End If@H_301_3@ End If@H_301_3@ @H_301_3@ s3 = ""@H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Right(ST1,Len(ST1) - 1 )@H_301_3@ s3 = CCh(Val(T1)) + s3@H_301_3@ End If@H_301_3@ @H_301_3@ @H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Right(ST1,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s3 = CCh(Val(T1)) + "拾" + s3@H_301_3@ Else@H_301_3@ If Left(s3, 1 ) <> "零" Then s3 = "零" + s3@H_301_3@ End If@H_301_3@ End If@H_301_3@ @H_301_3@ If ST1 <> "" Then@H_301_3@ T1 = Right(ST1,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s3 = CCh(Val(T1)) + "佰" + s3@H_301_3@ Else@H_301_3@ If Left(s3,Len(ST1) - 1 )@H_301_3@ If T1 <> "0" Then@H_301_3@ s3 = CCh(Val(T1)) + "仟" + s3@H_301_3@ End If@H_301_3@ End If@H_301_3@ If Right(s2, 1 ) = "零" Then s2 = Left(s2,Len(s2) - 1 )@H_301_3@ @H_301_3@ If Len(s3) > 0 Then@H_301_3@ @H_301_3@ If Right(s3, 1 ) = "零" Then s3 = Left(s3,Len(s3) - 1 )@H_301_3@ s3 = s3 & "万"@H_301_3@ End If@H_301_3@ @H_301_3@ ChMoney = IIf(s3 & s2 = "" ,s1,s3 & s2 & "元整" & s1)@H_301_3@ End Function

Function RMBChinese( ByVal Rmb As Double ) As String@H_301_3@ On Error Resume Next@H_301_3@ 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@H_301_3@ @H_301_3@ Rmb = Format(Rmb, "###0.00" )@H_301_3@ If Rmb > 999999999999.99 Then@H_301_3@ RMBChinese = "需转换的金额整数长度超过了12位！"@H_301_3@ Exit Function@H_301_3@ End If@H_301_3@ @H_301_3@ Rmbexp = "分角元拾佰仟万拾佰仟亿拾佰仟"@H_301_3@ Rmbda = "零壹贰叁肆伍陆柒捌玖"@H_301_3@ Ntyp = 0@H_301_3@ Trmb = Replace( CStr (Format(Rmb, "0.00" )), "." , "" )@H_301_3@ @H_301_3@ If Left(Trmb, 1 ) = "-" Then@H_301_3@ Trmb = Mid(Trmb, 2 )@H_301_3@ Ntyp = 1@H_301_3@ End If@H_301_3@ @H_301_3@ Expda = ""@H_301_3@ Icnt = Len(Trmb)@H_301_3@ @H_301_3@ For i = 1 To Icnt@H_301_3@ Expda = Mid(Rmbda,Val(Mid(Trmb,Icnt - i + 1 , 1 )) + 1 , 1 ) + IIf(Mid(Rmbexp,i, 1 ) = "元" ,Mid(Rmbexp, 1 ) + " " , 1 )) + Expda@H_301_3@ Next@H_301_3@ RMBChinese = IIf(Ntyp = 1 , "负" + Expda,Expda)@H_301_3@ End Function