数字转中文大写金额

        有时候，我们需要显示中文大写金额，比如打印银行付款申请单等。

        新建一个工程，加入一个标准模块在模块中加入如下代码，窗口中调用  AmountInChineseWords 函数即可。最大解析到百万亿，小数最多解析两位到分。

模块代码如下： 

'用户昵称: 留下些什么
'个人简介: 一个会做软件的货代
'CSDN网址：https://blog.csdn.net/zezese
'电子邮箱：[email protected]

Option Explicit


'最大解析到百万亿，小数最多解析两位到分

Function AmountInChineseWords(Amount As Double) As String

    If Amount < 0 Then
        AmountInChineseWords = "负" & AmountInChineseWords(Abs(Amount))
        Exit Function
    End If

    
    Dim strValue As String, strValueInWord As String
    strValue = CStr(Amount)
    
    Dim nPoint As Integer
    nPoint = InStrRev(strValue, ".")
    
    If nPoint > 0 Then '有小数点
        
        If Amount < 1 Then

            strValueInWord = DecimalInWord(Mid$(strValue, nPoint + 1), True)
            
        Else
    
            strValueInWord = IntegerInWord(Left$(strValue, nPoint - 1)) & DecimalInWord(Mid$(strValue, nPoint + 1), False)
            
        End If
    
    Else ' 没有小数点
        
        strValueInWord = IIf(Amount = 0, "零", IntegerInWord(strValue) & "整")
        
    End If
    
    AmountInChineseWords = strValueInWord
    
End Function


Private Function DecimalInWord(strValue As String, bTotalAmountLessThanOne As Boolean) As String
    
    Dim strChineseNumericWords()
    strChineseNumericWords = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
    
    Dim strRMBUnits()
    strRMBUnits = Array("角", "分")
    
    Dim i As Integer, nValue As Integer
    Dim strTmp As String, strValueInWord As String
    
    For i = 1 To Len(strValue)
    
        nValue = CInt(Mid$(strValue, i, 1))
        
        strTmp = strChineseNumericWords(nValue) & _
            IIf(nValue > 0, strRMBUnits(i - 1), "")
        
        strValueInWord = strValueInWord & strTmp
        
        If i = 2 Then Exit For '最多处理两位小数，到分
        
    Next

    If bTotalAmountLessThanOne And Left$(strValueInWord, 1) = "零" Then ' 0.01 这种情况需要把前面的零去掉
        strValueInWord = Mid$(strValueInWord, 2)
    End If
    
    DecimalInWord = strValueInWord
    
End Function


Private Function IntegerInWord(strValue As String) As String

    Dim strChineseNumericWords(), strChineseNumericUnits()
    
    strChineseNumericWords = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
    strChineseNumericUnits = Array("", "拾", "佰", "仟", "万", "拾", "佰", "仟", "亿", "拾", "佰", "仟", "万", "拾", "佰", "仟")
    
    Dim i As Integer, nValue As Integer
    Dim strTmp As String, strValueInWord As String
    
    For i = 1 To Len(strValue)
    
        nValue = CInt(Mid$(strValue, Len(strValue) - i + 1, 1))
        
        If (i = 5 Or i = 9 Or i = 13) And nValue = 0 Then '万, 亿, 万亿位
        
            strTmp = strChineseNumericUnits(i - 1)
            
        Else
            
            strTmp = strChineseNumericWords(nValue) & _
                IIf(nValue > 0, strChineseNumericUnits(i - 1), "")
            
        End If
        
        strValueInWord = strTmp & strValueInWord
        
        If i - 1 = UBound(strChineseNumericUnits) Then Exit For '最多处理到万亿
        
    Next
    
    
    '多个零只显示一个零
    Do
        If strValueInWord Like "*零零*" Then
            strValueInWord = Replace$(strValueInWord, "零零", "零")
        Else
            Exit Do
        End If
        
    Loop
    
    
    '处理一些特殊情况
    If strValueInWord Like "*零万*" Then
        strValueInWord = Replace$(strValueInWord, "零万", "万")
    End If

    If strValueInWord Like "*零亿*" Then
        strValueInWord = Replace$(strValueInWord, "零亿", "亿")
    End If

    If strValueInWord Like "*亿万*" Then
        strValueInWord = Replace$(strValueInWord, "亿万", "亿")
    End If
    
    
    '去头去尾
    If Left$(strValueInWord, 1) = "零" Then
        strValueInWord = Mid$(strValueInWord, 2)
    End If

    If Right$(strValueInWord, 1) = "零" Then
        strValueInWord = Left$(strValueInWord, Len(strValueInWord) - 1)
    End If
    
    IntegerInWord = strValueInWord & "元"

End Function