會員登錄 - 用戶注冊 - 網(wǎng)站地圖 Office中國(office-cn.net),專業(yè)Office論壇
當前位置:主頁 > 技巧 > Access技巧 > 模塊函數(shù)VBA > 正文

將金額數(shù)字轉換漢字大寫

時間:2004-11-23 22:48 來源:Office中國/Access中國 作者:yuab 閱讀:

作    者:yuab  
摘    要:將金額數(shù)字轉換漢字大寫的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 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 "數(shù)字過大無法轉換": 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


點擊瀏覽該文件


來 源 于:ACCESS中國

(責任編輯:admin)

頂一下
(0)
0%
踩一下
(0)
0%
發(fā)表評論
請自覺遵守互聯(lián)網(wǎng)相關的政策法規(guī),嚴禁發(fā)布色情、暴力、反動的言論。
評價: