有时候,我们需要显示中文大写金额,比如打印银行付款申请单等。
新建一个工程,加入一个标准模块在模块中加入如下代码,窗口中调用 AmountInChineseWords 函数即可。最大解析到百万亿,小数最多解析两位到分。
模块代码如下:
'用户昵称: 留下些什么
'个人简介: 一个会做软件的货代
'CSDN网址:https://blog.csdn.net/zezese
'电子邮箱:31319180@qq.comOption Explicit'最大解析到百万亿,小数最多解析两位到分Function AmountInChineseWords(Amount As Double) As StringIf Amount < 0 ThenAmountInChineseWords = "负" & AmountInChineseWords(Abs(Amount))Exit FunctionEnd IfDim strValue As String, strValueInWord As StringstrValue = CStr(Amount)Dim nPoint As IntegernPoint = InStrRev(strValue, ".")If nPoint > 0 Then '有小数点If Amount < 1 ThenstrValueInWord = DecimalInWord(Mid$(strValue, nPoint + 1), True)ElsestrValueInWord = IntegerInWord(Left$(strValue, nPoint - 1)) & DecimalInWord(Mid$(strValue, nPoint + 1), False)End IfElse ' 没有小数点strValueInWord = IIf(Amount = 0, "零", IntegerInWord(strValue) & "整")End IfAmountInChineseWords = strValueInWordEnd FunctionPrivate Function DecimalInWord(strValue As String, bTotalAmountLessThanOne As Boolean) As StringDim strChineseNumericWords()strChineseNumericWords = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")Dim strRMBUnits()strRMBUnits = Array("角", "分")Dim i As Integer, nValue As IntegerDim strTmp As String, strValueInWord As StringFor i = 1 To Len(strValue)nValue = CInt(Mid$(strValue, i, 1))strTmp = strChineseNumericWords(nValue) & _IIf(nValue > 0, strRMBUnits(i - 1), "")strValueInWord = strValueInWord & strTmpIf i = 2 Then Exit For '最多处理两位小数,到分NextIf bTotalAmountLessThanOne And Left$(strValueInWord, 1) = "零" Then ' 0.01 这种情况需要把前面的零去掉strValueInWord = Mid$(strValueInWord, 2)End IfDecimalInWord = strValueInWordEnd FunctionPrivate Function IntegerInWord(strValue As String) As StringDim strChineseNumericWords(), strChineseNumericUnits()strChineseNumericWords = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")strChineseNumericUnits = Array("", "拾", "佰", "仟", "万", "拾", "佰", "仟", "亿", "拾", "佰", "仟", "万", "拾", "佰", "仟")Dim i As Integer, nValue As IntegerDim strTmp As String, strValueInWord As StringFor 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)ElsestrTmp = strChineseNumericWords(nValue) & _IIf(nValue > 0, strChineseNumericUnits(i - 1), "")End IfstrValueInWord = strTmp & strValueInWordIf i - 1 = UBound(strChineseNumericUnits) Then Exit For '最多处理到万亿Next'多个零只显示一个零DoIf strValueInWord Like "*零零*" ThenstrValueInWord = Replace$(strValueInWord, "零零", "零")ElseExit DoEnd IfLoop'处理一些特殊情况If strValueInWord Like "*零万*" ThenstrValueInWord = Replace$(strValueInWord, "零万", "万")End IfIf strValueInWord Like "*零亿*" ThenstrValueInWord = Replace$(strValueInWord, "零亿", "亿")End IfIf strValueInWord Like "*亿万*" ThenstrValueInWord = Replace$(strValueInWord, "亿万", "亿")End If'去头去尾If Left$(strValueInWord, 1) = "零" ThenstrValueInWord = Mid$(strValueInWord, 2)End IfIf Right$(strValueInWord, 1) = "零" ThenstrValueInWord = Left$(strValueInWord, Len(strValueInWord) - 1)End IfIntegerInWord = strValueInWord & "元"End Function