Access自定义函数(人民币大写）

来源：互联网发布：淘宝15天自动确认收货编辑：程序博客网时间：2024/06/07 06:08

人民币大写函数：整数不超过13位。

Public Function 人民币大写(A) As String
Dim aa As String
Dim bb As String
Dim cc As String
Dim dd As Byte
Dim ee As Boolean
Dim ff As Byte
Dim i As Integer
Dim qq As String
    On Error GoTo CH_Err
    If A >= 0 Then
     aa = Int((A + 0.005) * 100)
     Else
     aa = -Int((A + 0.005) * 100)
     End If
      dd = Len(aa)
        For i = dd To 1 Step -1
         qq = Mid(aa, dd - i + 1, 1)
          bb = Mid("零壹贰叁肆伍陆柒捌玖拾", qq + 1, 1)
           If qq <> "0" Then
             If ee = True Then
              cc = cc + "零" + bb + Mid("分角元拾佰仟万拾佰仟亿拾佰仟万拾佰", i, 1)
            Else
              cc = cc + bb + Mid("分角元拾佰仟万拾佰仟亿拾佰仟万拾佰", i, 1)
            End If
              ee = False
            Else
              If i = 1 And qq = "0" Then
                cc = cc + "整"
              If aa = 0 Then
                 cc = ""
              End If
           Exit For
           End If
              If (i Mod 4 = 3) Then
               If ff < 4 Or i = 3 Then
                cc = cc + Mid("分角元拾佰仟万拾佰仟亿拾佰仟", i, 1)
               End If
              End If
            ee = True
         End If
       Next i
       If A >= 0 Then
     CH = cc
     Else
     CH = "负-" & cc
     End If
CH_Exit:
    Exit Function
CH_Err:
If A >= 0 And Len(Int(A)) >= 13 Or A < 0 And Len(Int(A)) >= 14 Then

     MsgBox "对不起！！！" + Chr(13) + "您输入的数值必须是:" & vbNewLine & "整数位不超过 13 位。", vbOKOnly, "警告"
    Else
    MsgBox Error$
    Resume CH_Exit
    End If
End Function

0 0