Office中国论坛/Access中国论坛

标题: [原创]数字金额转换成中文大写金额的函数 [打印本页]

作者: kmwell 时间: 2005-11-27 21:19
标题: [原创]数字金额转换成中文大写金额的函数
上传一个数字金额转换成中文大写金额的函数

Public Function MoneyConv(Money As Currency) As String
On Error GoTo Doerr

Dim CN(9) As String
Dim CU(15) As String
Dim Temp As String, strNum As String
Dim CM As String
Dim tFirst As String, tEnd As String
Dim i As Long, j As Long, k As Long
CN(0) = "零"
CN(1) = "壹"
CN(2) = "贰"
CN(3) = "叁"
CN(4) = "肆"
CN(5) = "伍"
CN(6) = "陆"
CN(7) = "柒"
CN(8) = "捌"
CN(9) = "玖"

' CU(0) = "分"
' CU(1) = "角"
CU(0) = "圆"
CU(1) = "十"
CU(2) = "佰"
CU(3) = "仟"
CU(4) = "万"
CU(5) = "十"
CU(6) = "佰"
CU(7) = "仟"
CU(8) = "亿"
CU(9) = "十"
CU(10) = "佰"
CU(11) = "仟"

If Money = 0 Then
      CM = "零圆整"
      GoTo Complete
End If
strNum = Trim(str(FormatCurrency(Money, 2, vbTrue, vbFalse, vbFalse)))
If Left(strNum, 1) = "-" Then
      tFirst = "负"
      strNum = Right(strNum, Len(strNum) - 1)
Else
      tFirst = ""
End If

i = InStrRev(strNum, ".")
If i <> 0 Then
      Temp = Right(strNum, i)
      If Len(strNum) - i = 1 Then Temp = Temp + "0"
      CM = CN(CInt(Left(Right(Temp, 2), 1))) + "角" + CN(CInt(Right(Temp, 1))) + "分"
      tEnd = ""
      strNum = Left(strNum, i - 1)
Else
      tEnd = "整"
End If

i = 0
For j = Len(strNum) To 1 Step -1
      k = CInt(Right(Left(strNum, j), 1))
      If k = 0 Then
         If i <> 0 And i <> 4 And i <> 8 Then
            CM = CN(k) + CM
         Else
            CM = CN(k) + CU(i) + CM
         End If
      Else
         CM = CN(k) + CU(i) + CM
      End If
'       CM = CN(k) + CU(i) + CM
      i = i + 1
Next j

CM = tFirst + CM + tEnd
CM = Replace(CM, "零零", "零")
CM = Replace(CM, "零零", "零")
CM = Replace(CM, "亿零万零圆", "亿圆")
CM = Replace(CM, "亿零万", "亿零")
CM = Replace(CM, "万零圆", "万圆")
CM = Replace(CM, "零亿", "亿")
CM = Replace(CM, "零万", "万")
CM = Replace(CM, "零圆", "圆")
CM = Replace(CM, "零零", "零")
CM = Replace(CM, "零零", "零")       '重复替换一次

Complete:
Gerr = 0             '操作成功,无错误发生
MoneyConv = CM
Exit Function
Doerr:
Gerr = -1             '未知错误
Errexit:
MoneyConv = ""
End Function[em07][em07]

作者: bee2002 时间: 2006-11-11 07:11
可是,我是菜鸟,实在不知道怎么一步步操作那?

作者: bee2002 时间: 2006-11-11 07:13
希望大侠能详细指导一下怎么操作,谢谢啊!

作者: sblisb 时间: 2006-11-11 21:50
做一个示例出来就好了

作者: sblisb 时间: 2006-11-11 22:00
例子在这里，里面有两个不同的函数，效果也不一样

楼主的是第二个例子[attach]21457[/attach]

作者: sblisb 时间: 2006-11-12 04:30
觉得这两个函数做得不完美，

10.1元时，得出的是壹拾元壹角零分，最好不要体现零分，只要壹拾元壹角整就成

作者: yefei80 时间: 2006-11-25 21:45
电风扇电风扇电风扇

作者: wandiansong 时间: 2007-7-14 17:05
555

作者: eyewitnes 时间: 2007-7-17 18:26
仅供参考

Public Function URmb(ByVal Money As Currency) As String
'一个简单的小写金额转中文的函数

'作者: 海狸先生

Dim i As Integer, strMoney As String

strMoney = StrReverse(Format(Money, "#.##") * 100)

If Len(strMoney) > 14 Then MsgBox "超出范围！": Exit Function

For i = 1 To Len(strMoney)
URmb = Mid$("零壹贰叁肆伍陆柒捌玖", Mid$(strMoney, i, 1) + 1, 1) & Mid$("分角元拾佰仟万拾佰仟亿拾佰仟", i, 1) & URmb
Next

End Function

作者: jicheng 时间: 2007-7-17 18:43
[attach]25373[/attach]

搜索一下例子有好多

作者: cosby 时间: 2007-8-4 13:53
好贴,我正需要的....

作者: junta 时间: 2008-5-6 15:40
怎样使用呢

作者: lbq727 时间: 2009-10-15 11:35
很需要

作者: WFH6898 时间: 2015-11-12 12:38
代码非常实用啊

作者: yhl091122 时间: 2016-3-25 16:46
谢谢

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)