作 者：yuab 摘 要：将金额数字转换汉字大写的VBA程序正 文：调用方法如图：
| Public Function AAA(number As Variant) As String If (IsNull(number)) Then AAA = "错误：传入负值或Null值" Else Select Case number Case 0: AAA = "零" Case 1: AAA = "壹" Case 2: AAA = "贰" Case 3: AAA = "叁" Case 4: AAA = "肆" Case 5: AAA = "伍" Case 6: AAA = "陆" Case 7: AAA = "柒" Case 8: AAA = "捌" Case 9: AAA = "玖" Case 10 ^ 1: AAA = "分" Case 10 ^ 2: AAA = "角" Case 10 ^ 3: AAA = "元" Case 10 ^ 4, 10 ^ 8, 10 ^ 12: AAA = "拾" Case 10 ^ 5, 10 ^ 9, 10 ^ 13: AAA = "佰" Case 10 ^ 6, 10 ^ 10, 10 ^ 14: AAA = "仟" Case 10 ^ 7: AAA = "萬" Case 10 ^ 11: AAA = "亿" End Select End IfEnd Function
Public Function abc(number As Variant, canshu As Long) As String Dim C, D, Y, X, Z As String Dim A, b, k A = Int(number * 100 + 0.5) b = Len(CStr(A)) D = CStr(A) If (b > 14) Then MsgBox "数字过大无法转换": Exit Function If (number < 0) Then MsgBox "错误：不可传入负值": Exit Function If A = 0 Then abc = "": Exit Function For k = 1 To b Select Case canshu Case 1 Y = AAA(Mid(D, b - k + 1, 1)) + AAA(10 ^ k) Select Case k Case 1 If Mid(D, b, 1) = "0" Then C = "整" Else C = Y + C Case 2, 4, 5, 6, 8, 9, 10, 12, 13, 14 If Mid(D, b - k + 1, 2) = "00" Then C = C _ Else: _ If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" Then _ C = "零" + C Else: C = Y + C Case 7 If b >= 11 Then If Mid(D, b - k - 2, 4) = "0000" Then C = C Else If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) = "0" _ Then C = AAA(10 ^ k) + C _ Else: If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" _ Then C = AAA(10 ^ k) + "零" + C Else: C = Y + C End If Else If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) = "0" _ Then C = AAA(10 ^ k) + C _ Else: If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" _ Then C = AAA(10 ^ k) + "零" + C Else: C = Y + C End If Case 3, 11 If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) = "0" _ Then C = AAA(10 ^ k) + C _ Else: If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" _ Then C = AAA(10 ^ k) + "零" + C Else: C = Y + C End Select Case 2 C = AAA(Mid(D, b - k + 1, 1)) + " " + C Case 3 C = AAA(Mid(D, b - k + 1, 1)) + AAA(10 ^ k) + C End Select Next abc = CEnd Function |