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 If
End 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 = C
End Function |
|站长邮箱|小黑屋|手机版|Office中国/Access中国
( 粤ICP备10043721号-1 ) 
