人民币大写|人民币大写VB6.0+Access2000解决
人民币大写转换在用VB6.0+Access2000编写票据打印程序中是个很棘手的问题。"123.45"转换成"壹佰贰拾叁元肆角伍分整",VB6.0本身未提供这样的转换函数，笔者经过反复调试,成功开发一个短小精悍的人民币大写转换函数.
| 以下是代码片段： 人民币大写转换函数如下： Public Function rmb(s As Currency) As String s1$ = LTrim(Str$(Abs(s))) L% = Len(s1) Select Case L - InStrRev(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 调用: 首先需要使用DAO3.6以上版本的数据库引擎(在"工程"--"引用"中选择"Microsoft DAO 3.6 Object Library"),然后: Private Sub Form_Load() 'b1是Access的数据库abc.mdb中 的表,再假设表中第i个字段是数字金额. Set db = OpenDatabase ("c:\my documents\abc.mdb") Set rs = db.OpenRecordset("b1") End Sub Private Sub command1_click() '把当前记录第i个字段的 数字金额转换为人民币大写 x$=rmb(CCur(rs.fields(i))) '此处是打印代码 End Sub 结论: 本函数rmb()方便地实现了数字金额转换成人民币大写,正负数皆可,最大能转换百亿以内的数.以上函数在Win98,VB6.0中文企业版+Access2000中运行通过。:) |
| 以下是代码片段： 使用下面这个函数，如Print ChineseFormat(11.4)。 Function ChineseFormat(n As Variant) Dim s As String, sFormat As String Dim i As Integer, c As String Const sString = "分角元拾佰仟万拾佰仟亿拾佰仟万" Const sNumber = "零壹贰叁肆伍陆柒捌玖" s = Format(Int(n * 100)) sFormat = "" For i = Len(s) To 1 Step -1 c = Mid(s, i, 1) sFormat = Mid(sNumber, Val(c) _ + 1, 1) + Mid(sString, Len(s) - i + 1, 1) _ + sFormat Next ChineseFormat = sFormat End Function 对于数字中出现0的情况，如 Print ChineseFormat(2008.04) 这个函数的输出结果是“贰仟零佰零拾捌元零角肆分”，如果希望结果是“贰仟零捌元零角肆分”。可以修改函数为： Function ChineseFormat(n As Variant) Dim s As String, sFormat As String Dim i As Integer, c As String Const sString = "分角元拾佰仟万拾佰仟亿拾佰仟万" Const sNumber = "零壹贰叁肆伍陆柒捌玖" s = Format(Int(n * 100)) sFormat = "" For i = Len(s) To 1 Step -1 c = Mid(s, i, 1) If c = "0" Then Select Case Len(s) - i Case Is <= 1 ' 0在元之后 sFormat = "零" + Mid(sString, Len(s) - i + 1, 1) _ + sFormat Case 2 ' 元 sFormat = "元" + sFormat Case Else If Mid(s, i + 1, 1) <> "0" Then sFormat = "零" + sFormat End Select Else sFormat = Mid(sNumber, Val(c) _ + 1, 1) + Mid(sString, Len(s) - i + 1, 1) _ + sFormat End If Next ChineseFormat = sFormat End Function |