cmoney.bas

转换成汉字大写金额

Attribute VB_Name = "CMoney"
'名称： Num2Money
'       得到数字 nMoney 的汉字大写
'范围:  只受货币型变量大小的限制,超过则自动截取范围内的数值
'       O 返回 ""

Public Function Num2Money(ByVal nMoney As Currency) As String
Dim strMoney, strDec, strInt, cNum As String
Dim locDec, i, j As Integer                         '小数点位置

Dim d(4) As String                                  '元以下的单位
Dim t(3) As String                                  '万以下的单位
Dim w(3) As String                                  '阶符
Dim n(9) As String                                  '数字
Dim s(4) As String                                  '用以保存临时转化后的值
    
    d(0) = "": d(1) = "角": d(2) = "分": d(3) = "厘": d(4) = "毫"
    t(0) = "": t(1) = "十": t(2) = "百": t(3) = "千"
    w(0) = "": w(1) = "元": w(2) = "万": w(3) = "亿"
    n(0) = "零": n(1) = "壹": n(2) = "贰": n(3) = "叁": n(4) = "肆":
    n(5) = "伍": n(6) = "陆": n(7) = "柒": n(8) = "捌": n(9) = "玖"

    If nMoney = 0 Then                              '为"0"则退出
        Num2Money = vbNullString
        Exit Function
    End If

    If nMoney < 0 Then                              '为负则递归求解
        Num2Money = "负" + Num2Money(Abs(nMoney))
        Exit Function
    End If

    strMoney = Trim(Str(nMoney))

    locDec = InStr(strMoney, ".")                   '小数点位置

    s(0) = ""

    If locDec > 0 Then
        strDec = Right(strMoney, Len(strMoney) - locDec)
              
        If strDec <> "" Then                        '转化小数部分
            For i = 1 To Len(strDec)
                cNum = Left(strDec, 1)
                strDec = Right(strDec, Len(strDec) - 1)
                If cNum <> "0" Then
                    s(0) = s(0) & n(Val(cNum)) & d(i)
                    Debug.Print s(0)
                End If
            Next
        End If
        strInt = Left(strMoney, locDec - 1)         '取整数部分的值
    Else
        strInt = strMoney
    End If

                                            '考虑到VB中货币型变量的范围,不超过 "1000万亿". & _
                                            (-922,337,203,685,477.5808 ~ 922,337,203,685,477.5807)
    For i = 0 To Len(strInt) / 4            '每4个数字一组进行转换
        
        s(i + 1) = ""
        For j = 0 To 3
            If strInt <> "" Then
                cNum = Right(strInt, 1)     '取末位数
                strInt = Left(strInt, Len(strInt) - 1)
                If cNum <> "0" Then         '不为零则加单位
                    s(i + 1) = n(Val(cNum)) & t(j) & s(i + 1)
                Else
                    s(i + 1) = n(Val(cNum)) & s(i + 1)
                End If
                Debug.Print s(i + 1)
            End If                          '删除重复的"零"
            s(i + 1) = Replace(s(i + 1), "零零", "零")
        Next
        Debug.Print Right(s(i + 1), 1)
        
        If Right(s(i + 1), 1) = "零" Then   '删除末位的"零"
            s(i + 1) = Left(s(i + 1), Len(s(i + 1)) - 1)
        End If
        
        Debug.Print s(i + 1)
    Next
    
    Num2Money = ""
    For i = 0 To 2                          '连接整数位
        Num2Money = Num2Money & s(3 - i) & IIf(Trim(s(3 - i)) = vbNullString, vbNullString, w(3 - i))
    Next
    
                                            '加上"元"
    If Trim(Num2Money) <> vbNullString And Right(Num2Money, 1) <> "元" Then
        Num2Money = Num2Money & "元"
    End If
                                            '若无小数则加应加上"整"
    If Trim(s(0)) = vbNullString Then
        Num2Money = Num2Money & "整"
    Else
        Num2Money = Num2Money & s(0)
    End If
End Function