www.pudn.com > 转换成汉字大写金额.zip > 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