Access金额数字转换为中文大写03版套印模式

Option Compare Database
Option Explicit

'-------------------------
'编者  张义成（儿化韵）
'日期  2016-07-30
'-------------------------
'控件属性：
'txt金额数字：格式 空白。 小数位数 自动。 文本对齐 右。  是否锁定 否。 制表位 是。
'txt金额大写：格式 空白。 小数位数 自动。 文本对齐 左。  是否锁定 是。 制表位 否。
'txt金额单位：格式 空白。 小数位数 自动。 文本对齐 左。  是否锁定 是。 制表位 否。背景样式 透明。
             '默认值 "人民币  亿  仟  佰  拾  万  仟  佰  拾  元  角  分"
             '与 txt金额大写 叠合。
'-------------------------

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

Private Function fun金额大写()
        Dim varA As Variant
        Dim varB As Variant
        Dim strE As String
        Dim strF As String
        Dim varH As Variant
        Dim varJ As Variant
        Dim varK As Variant
        Dim varM As Variant
        Dim varN As Variant
        Dim strQ As String
        Dim strR As String
        Dim strS As String
        Dim strT As String
        Dim lngV As Long
        Dim lngW As Long
        Dim lngX As Long
        Dim lngY As Long
            varM = txt金额数字
    If IsNumeric(varM) Then
                '应用 varM = Val(varM) 赋值语句，可以直接舍弃数字首尾的 0 和尾部的点号（.），
                '但是 Val() 函数遇到超长整数时，会以 CDbl() 函数替代转换，所以不宜在此使用。
                '本示例整数部分按长整型处理，从 -2,147,483,648 到 2,147,483,647 。超出范围，系统将会报告溢出。
                '由于负值没有实际意义，故将 - 号去掉，变为正值。由此，-2,147,483,648 也会溢出。
                '本示例最高位值为亿，故超出部分会被舍弃。
            txt金额数字备份 = varM
            varM = Replace(varM, "-", "")
            If Right(varM, 1) = "." Then varM = Left(varM, Len(varM) - 1)
            varN = InStr(varM, ".")
        Select Case varN
            Case 0
                    varA = CLng(varM)
                    If Len(varA) > 9 Then varA = Right(varA, 9)
                    lngV = Len(varA)
                    lngW = 1
                Do
                        varJ = Mid(varA, lngW, 1)
                    Select Case varJ
                        Case 0
                            strQ = "零  "
                        Case 1
                            strQ = "壹  "
                        Case 2
                            strQ = "贰  "
                        Case 3
                            strQ = "叁  "
                        Case 4
                            strQ = "肆  "
                        Case 5
                            strQ = "伍  "
                        Case 6
                            strQ = "陆  "
                        Case 7
                            strQ = "柒  "
                        Case 8
                            strQ = "捌  "
                        Case 9
                            strQ = "玖  "
                        Case Else
                            MsgBox "代码 fun金额大写() 的 Case 0 组 Select Case varJ 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                            Exit Function
                    End Select
                        strR = strR & strQ
                        lngW = lngW + 1
                Loop Until lngW = lngV + 1
                Select Case lngV
                    Case 1
                        strE = "×  ×  ×  ×  ×  ×  ×  ×  " & strR
                    Case 2
                        strE = "×  ×  ×  ×  ×  ×  ×  " & strR
                    Case 3
                        strE = "×  ×  ×  ×  ×  ×  " & strR
                    Case 4
                        strE = "×  ×  ×  ×  ×  " & strR
                    Case 5
                        strE = "×  ×  ×  ×  " & strR
                    Case 6
                        strE = "×  ×  ×  " & strR
                    Case 7
                        strE = "×  ×  " & strR
                    Case 8
                        strE = "×  " & strR
                    Case 9
                        strE = strR
                    Case Else
                        MsgBox "代码 fun金额大写() 的 Case 0 组 Select Case lngV 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                        Exit Function
                End Select
                    txt金额数字 = varA
                    varH = Format(varA, "#,##0")
                    txt金额大写 = "人民币" & strE & "×  ×  " & "  ￥" & varH
            Case 1
                    varB = Mid(varM, InStr(varM, ".") + 1)
                    If Len(varB) > 2 Then varB = Left(varB, 2)
                    lngX = Len(varB)
                    lngY = 1
                Do
                        varK = Mid(varB, lngY, 1)
                    Select Case varK
                        Case 0
                            strS = "零  "
                        Case 1
                            strS = "壹  "
                        Case 2
                            strS = "贰  "
                        Case 3
                            strS = "叁  "
                        Case 4
                            strS = "肆  "
                        Case 5
                            strS = "伍  "
                        Case 6
                            strS = "陆  "
                        Case 7
                            strS = "柒  "
                        Case 8
                            strS = "捌  "
                        Case 9
                            strS = "玖  "
                        Case Else
                            MsgBox "代码 fun金额大写() 的 Case 1 组 Case varK 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                            Exit Function
                    End Select
                        strT = strT & strS
                        lngY = lngY + 1
                Loop Until lngY = lngX + 1
                Select Case lngX
                    Case 1
                        strF = "×  ×  ×  ×  ×  ×  ×  ×  ×  " & strT & "×  "
                    Case 2
                        strF = "×  ×  ×  ×  ×  ×  ×  ×  ×  " & strT
                    Case Else
                        MsgBox "代码 fun金额大写() 的 Case 1 组 Case lngX 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                        Exit Function
                End Select
                    txt金额数字 = "." & varB
                    varH = "." & varB
                    txt金额大写 = "人民币" & strF & "  ￥" & varH
            Case Is > 1
                    varA = CLng(Mid(varM, 1, InStr(varM, ".") - 1))
                    If Len(varA) > 9 Then varA = Right(varA, 9)
                    lngV = Len(varA)
                    lngW = 1
                Do
                        varJ = Mid(varA, lngW, 1)
                    Select Case varJ
                        Case 0
                            strQ = "零  "
                        Case 1
                            strQ = "壹  "
                        Case 2
                            strQ = "贰  "
                        Case 3
                            strQ = "叁  "
                        Case 4
                            strQ = "肆  "
                        Case 5
                            strQ = "伍  "
                        Case 6
                            strQ = "陆  "
                        Case 7
                            strQ = "柒  "
                        Case 8
                            strQ = "捌  "
                        Case 9
                            strQ = "玖  "
                        Case Else
                            MsgBox "代码 fun金额大写() 的 Case Is > 1 组 Select Case varJ 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                            Exit Function
                    End Select
                        strR = strR & strQ
                        lngW = lngW + 1
                Loop Until lngW = lngV + 1
                Select Case lngV
                    Case 1
                        strE = "×  ×  ×  ×  ×  ×  ×  ×  " & strR
                    Case 2
                        strE = "×  ×  ×  ×  ×  ×  ×  " & strR
                    Case 3
                        strE = "×  ×  ×  ×  ×  ×  " & strR
                    Case 4
                        strE = "×  ×  ×  ×  ×  " & strR
                    Case 5
                        strE = "×  ×  ×  ×  " & strR
                    Case 6
                        strE = "×  ×  ×  " & strR
                    Case 7
                        strE = "×  ×  " & strR
                    Case 8
                        strE = "×  " & strR
                    Case 9
                        strE = strR
                    Case Else
                        MsgBox "代码 fun金额大写() 的 Case Is > 1 组 Select Case lngV 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                        Exit Function
                End Select
                    varB = Mid(varM, InStr(varM, ".") + 1)
                    If Len(varB) > 2 Then varB = Left(varB, 2)
                    lngX = Len(varB)
                    lngY = 1
                Do
                        varK = Mid(varB, lngY, 1)
                    Select Case varK
                        Case 0
                            strS = "零  "
                        Case 1
                            strS = "壹  "
                        Case 2
                            strS = "贰  "
                        Case 3
                            strS = "叁  "
                        Case 4
                            strS = "肆  "
                        Case 5
                            strS = "伍  "
                        Case 6
                            strS = "陆  "
                        Case 7
                            strS = "柒  "
                        Case 8
                            strS = "捌  "
                        Case 9
                            strS = "玖  "
                        Case Else
                            MsgBox "代码 fun金额大写() 的 Case Is > 1 组 Select Case varK 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                            Exit Function
                    End Select
                        strT = strT & strS
                        lngY = lngY + 1
                Loop Until lngY = lngX + 1
                Select Case lngX
                    Case 1
                        strF = strT & "×  "
                    Case 2
                        strF = strT
                    Case Else
                        MsgBox "代码 fun金额大写() 的 Case Is > 1 组 Select Case lngX 段 Case Else 报告出错 ！", vbExclamation, "郑重提示"
                        Exit Function
                End Select
                    txt金额数字 = varA & "." & varB
                    varH = Format(varA, "#,##0") & "." & varB
                    txt金额大写 = "人民币" & strE & strF & "  ￥" & varH
            Case Else
                MsgBox "出现了可能与 小数点 相关的错误 ！", vbExclamation, "郑重提示"
                Exit Function
        End Select
    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