http://www.accessoft.com/article-show.asp?id=5611
'===============================================================================================
'-函数名称: 数字大写
'-功能描述: 将阿拉伯数字转换成中文数字
'-输入参数: Number 要转换的数字
'-返回参数: 返回转换后得到的中文数字
'-使用示例: =数字大写(481000001.02) '返回值：肆亿捌千壹百万〇壹点〇贰
'-相关调用:
'-使用注意:
'-兼 容 性: 最大上限为壹亿的3次方，超出此限会出错
'-参考资料:
'-作 者: 红尘如烟
'-创建日期; 2011-7-5
'===============================================================================================
Public Function 数字大写(Number As Variant) As String
Dim strDecimal As String
Dim strInteger As String
Dim lngPos As Long
Dim strNumber As Variant
Dim varNum As String
Dim strCarry As String
Dim lngI As Long
strNumber = CStr(CDec(nz(Number, 0)))
lngPos = InStr(1, strNumber, ".")
If lngPos > 0 Then
strDecimal = Mid(strNumber, lngPos + 1)
For lngI = 1 To Len(strDecimal)
varNum = Mid(strDecimal, lngI, 1)
If varNum = 0 Then varNum = 10
Mid(strDecimal, lngI, 1) = Mid("壹贰叁肆伍陆柒捌玖零", varNum, 1)
Next
strDecimal = "点" & strDecimal
strInteger = StrReverse(Left(strNumber, lngPos - 1))
Else
strInteger = StrReverse(strNumber)
End If
If nz(Number, 0) = 0 Then
数字大写 = "(无数量)"
Else
strCarry = " 拾 百 千 万 拾 百 千 亿 拾 百 千 万 拾 百 千 亿 拾 百 千 万 拾 百 千 亿"
strInteger = Replace(strInteger, "-", "")
For lngI = 1 To Len(strInteger)
varNum = Mid(strInteger, lngI, 1)
If varNum = 0 Then varNum = 10
Mid(strCarry, lngI * 2, 1) = Mid$("壹贰叁肆伍陆柒捌玖零", varNum, 1)
Next
strCarry = Trim(strCarry)
strInteger = StrReverse(strCarry)
strInteger = Mid$(strInteger, InStrRev(strInteger, " ") + 2)
strInteger = Replace(strInteger, "零拾", "零")
strInteger = Replace(strInteger, "零百", "零")
strInteger = Replace(strInteger, "零千", "零")
Do Until Not strInteger Like "*零零*"
strInteger = Replace(strInteger, "零零", "零")
Loop
strInteger = Replace(strInteger, "零拾", "拾")
strInteger = Replace(strInteger, "零百", "百")
strInteger = Replace(strInteger, "零千", "千")
strInteger = Replace(strInteger, "零万", "万")
strInteger = Replace(strInteger, "零亿", "亿")
strInteger = Replace(strInteger, "亿万", "亿零")
strInteger = Replace(strInteger, "壹拾亿", "拾亿")
strInteger = Replace(strInteger, "壹拾万", "拾万")
Do Until Not strInteger Like "*零零*"
strInteger = Replace(strInteger, "零零", "零")
Loop
If Right$(strInteger, 1) = "零" Then strInteger = Left$(strInteger, Len(strInteger) - 1)
If Number < 0 Then strInteger = "负" & strInteger
数字大写 = "数量合计：" & strInteger & strDecimal
End If
End Function
611