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
|