您的位置：　首页 > 技术文章 > 源码示例

Access金额数字转换为中文大写01版

来源:www.accessoft.com 点击数:11409 　 | 收藏 | 复制

时　间:2016-07-22 00:00:00
作　者:张义成 ID：37928 城市：赤峰
摘　要:Access金额数字转换为中文大写01版
正　文:

近日习作，交流切磋，欢迎指正。
亿位上限，个位下限，角分舍弃。

附件:

点击下载此示例

图示:

源码:

Option Compare Database
Option Explicit

'--------------------
'编者张义成
'日期 2016-07-20
'--------------------

Private Sub txt金额数字_AfterUpdate()
On Error GoTo ErrorHandler
    Call fun金额大写
    Me.txt空白.SetFocus
ErrorHandlerExit:
    Me.txt空白.SetFocus
    Exit Sub
ErrorHandler:
    MsgBox "Error No：" & Err.Number & "    Description：" & Err.Description
    Resume ErrorHandlerExit
End Sub

Function fun金额大写()
        Dim varJ As Variant
        Dim strK As String
        Dim strM As String
        Dim strN As String
        Dim lngX As Long
        Dim lngY As Long
    If IsNumeric(txt金额数字) Then                       'IsNumeric() 判断是否为数。
            txt金额数字 = Abs(txt金额数字)               'Abs()        绝对值函数，负数转为正数。
            txt金额数字 = CLng(txt金额数字)              'CLng()       长整型函数，取整。
        If Len(txt金额数字) > 9 Then
            txt金额数字 = Right(CStr(txt金额数字), 9)
            txt金额数字 = CLng(txt金额数字)
        End If
            varJ = txt金额数字
            strN = ""
            lngX = Len(txt金额数字)
            lngY = 1
        Do
                strK = Mid(CStr(varJ), lngY, 1)
            Select Case strK
                Case 0
                    strM = "零"
                Case 1
                    strM = "壹"
                Case 2
                    strM = "贰"
                Case 3
                    strM = "叁"
                Case 4
                    strM = "肆"
                Case 5
                    strM = "伍"
                Case 6
                    strM = "陆"
                Case 7
                    strM = "柒"
                Case 8
                    strM = "捌"
                Case 9
                    strM = "玖"
                Case Else
            End Select
            Select Case lngX
                Case 9
                    strN = strN + strM + Choose(lngY, "亿", "仟", "佰", "拾", "万", "仟", "佰", "拾", "元整")
                Case 8
                    strN = strN + strM + Choose(lngY, "仟", "佰", "拾", "万", "仟", "佰", "拾", "元整")
                Case 7
                    strN = strN + strM + Choose(lngY, "佰", "拾", "万", "仟", "佰", "拾", "元整")
                Case 6
                    strN = strN + strM + Choose(lngY, "拾", "万", "仟", "佰", "拾", "元整")
                Case 5
                    strN = strN + strM + Choose(lngY, "万", "仟", "佰", "拾", "元整")
                Case 4
                    strN = strN + strM + Choose(lngY, "仟", "佰", "拾", "元整")
                Case 3
                    strN = strN + strM + Choose(lngY, "佰", "拾", "元整")
                Case 2
                    strN = strN + strM + Choose(lngY, "拾", "元整")
                Case 1
                    strN = strN + strM + Choose(lngY, "元整")
                Case Else
            End Select
                lngY = lngY + 1
        Loop Until lngY = lngX + 1
            varJ = Format(varJ, "#,##0")
            txt金额大写 = "人民币" & strN & " ￥" & varJ
    Else
        MsgBox "金额数字不合规范", vbExclamation, "郑重提示"
        txt金额大写 = Null
    End If
End Function

Private Sub cmd关闭_Click()
On Error GoTo ErrorHandler
    DoCmd.Close
ErrorHandlerExit:
    Exit Sub
ErrorHandler:
    MsgBox "Error No：" & Err.Number & "    Description：" & Err.Description
    Resume ErrorHandlerExit
End Sub