数字金额转中文金额的两种方法access2000

其实不是我的原创啦，只是有些改进，我忘了在哪找到的啦（真对不起作者） 非常实用，得感谢作者。如果有谁知道作者，请告诉我。谢谢啦 这是将数字金额转为中文金额的自定义函数，可以将数字转化为中文字表示的金额（我想这个软件如果外国人也能感兴趣就好，那说明中文已经要取代英文啦，呵呵:) ） 这个功能在窗体和报表中非常实用，省去你不少时间和精力 （限量下载，下载请早哦，呵呵） 你可以到我的主页（轻魂编程百宝箱） http://www.zstmcomputer.com 或 http://tmcomputer.6to23.com 免费获得其它完整的应用软件或一些已公开的源码。 电子信箱:wang_yu_hong@163.net tmtony@21cn.com 第一个程序 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) As String Dim tMoney As String Dim lMoney As String Dim tn Dim s1 As String '临时STRING 小数部分 Dim s2 As String ' Dim ST1 As String Dim t1 As String Dim s3 As String 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 's1 = "元" + s1 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(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 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 = s3 & s2 & "元" & s1 End Function 第二个程序 Function rmb(s As Currency) As String Dim s1, s2, C1, C2, DX, X As String Dim L As Integer s1 = LTrim(Str$(Abs(s))) L = Len(s1) Select Case L - InStr(s1, ".") '双引号内是小数点 Case L s2 = s1 + ".00" Case 1 s2 = s1 + "0" Case 2 s2 = s1 End Select L = Len(s2) DX = "" C1 = "零壹贰叁肆伍陆柒捌玖" C2 = "分角 元拾佰仟万拾佰仟亿拾佰" '角和元之间留一个空格 Do While L >= 1 X = Mid(s2, Len(s2) - L + 1, 1) DX = DX + IIf(X <> ".", Mid(C1, Val(X) + 1, 1) + " " + Trim(Mid(C2, (L - 1) + 1, 1)) + " ", "") L = L - 1 Loop rmb = DX + " 整" End Function