Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

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

时 间:2016-08-03 14:06:35
作 者:张义成   ID:37928  城市:赤峰
摘 要: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

 



Access软件网官方交流QQ群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助