金额大小写转换？？？

[DaneWoo]

请问如何将小写金额转换为大写的（例如 102.5 元转换圆 ’壹佰零贰圆伍角‘） ？
非常急！！！
非常感谢！！！

[exiong]

有的。怎么给你啊？

[DaneWoo]

我得EMAIL: [e-mail]

[dsclub]

http://www.csdn.net/expert/topic/923/923999.xml?temp=.2048609

[cgh1970]

我发过了！

[qiqif]

转贴
' 本模块生成汉字大写的金额
'
Option Explicit
' 名称： CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private Function CCh(N1) As String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh = "壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh = "肆"
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh = "柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End Function
'名称： ChMoney
' 得到数字 N1 的汉字大写
' 最大为 千万位
' O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim ST1 As String
Dim T1 As String
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000



If N1 = 0 Then
ChMoney = " "
Exit Function
End If
If N1 < 0 Then
ChMoney = "负" + ChMoney(Abs(N1))
Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 = ""
If tn <> 0 Then
ST1 = Right(tMoney, Len(tMoney) - tn)
If ST1 <> "" Then
T1 = Left(ST1, 1)
ST1 = Right(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s1 = s1 + CCh(Val(T1)) + "角"
End If
If ST1 <> "" Then
T1 = Left(ST1, 1)
s1 = s1 + CCh(Val(T1)) + "分"
End If
End If
ST1 = Left(tMoney, tn - 1)
Else
ST1 = tMoney
End If

s2 = ""
If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 = CCh(Val(T1)) + s2
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s2 = CCh(Val(T1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s2 = CCh(Val(T1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s2 = CCh(Val(T1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

s3 = ""
If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s3 = CCh(Val(T1)) + s3
End If


If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s3 = CCh(Val(T1)) + "拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s3 = CCh(Val(T1)) + "佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If

If ST1 <> "" Then
T1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If T1 <> "0" Then
s3 = CCh(Val(T1)) + "仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)

If Len(s3) > 0 Then

If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If

ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元整" & s1)
End Function

[wzsswz]

保你满意：
http://www.csdn.net/expert/topic/918/918115.xml?temp=.4171411

[houtianxi]

试试我的这2个函数，放到模块里，直接调用就是了~~

'入口：Money 金额
'出口：大写金额
Public Function MoneyToChinese(Money As Double) As String
Dim i As Long
Dim mstrSource As String

If Money = 0 Then MoneyToChinese = vbNullString: Exit Function
mstrSource = Format(CStr(Abs(Money)), "#0.00")
i = InStr(1, mstrSource, ".")
If i > 0 Then mstrSource = Mid(mstrSource, 1, i - 1) + Mid(mstrSource, i + 1, Len(mstrSource) - i)
If Left(mstrSource, 1) = "0" Then mstrSource = Mid(mstrSource, 2, Len(mstrSource) - 1)

mstrSource = NumstrToChinese(mstrSource)
If Len(Trim(mstrSource)) = 0 Then MoneyToChinese = vbNullString: Exit Function
If Money < 0 Then mstrSource = Trim("A") & Trim(mstrSource) '负

For i = 1 To Len(mstrSource)
Select Case Mid(mstrSource, i, 1)
Case "0"
MoneyToChinese = MoneyToChinese + "零"
Case "1"
MoneyToChinese = MoneyToChinese + "壹"
Case "2"
MoneyToChinese = MoneyToChinese + "贰"
Case "3"
MoneyToChinese = MoneyToChinese + "叁"
Case "4"
MoneyToChinese = MoneyToChinese + "肆"
Case "5"
MoneyToChinese = MoneyToChinese + "伍"
Case "6"
MoneyToChinese = MoneyToChinese + "陆"
Case "7"
MoneyToChinese = MoneyToChinese + "柒"
Case "8"
MoneyToChinese = MoneyToChinese + "捌"
Case "9"
MoneyToChinese = MoneyToChinese + "玖"
Case "M"
MoneyToChinese = MoneyToChinese + "亿"
Case "W"
MoneyToChinese = MoneyToChinese + "万"
Case "S"
MoneyToChinese = MoneyToChinese + "仟"
Case "H"
MoneyToChinese = MoneyToChinese + "佰"
Case "T"
MoneyToChinese = MoneyToChinese + "拾"
Case "Y"
MoneyToChinese = MoneyToChinese + "圆"
Case "J"
MoneyToChinese = MoneyToChinese + "角"
Case "F"
MoneyToChinese = MoneyToChinese + "分"
Case "A"
MoneyToChinese = MoneyToChinese + "负"
End Select
Next i
If Right(Trim(MoneyToChinese), 1) <> "分" Then MoneyToChinese = MoneyToChinese + "整"
End Function

'4.金额转换，大写--〉小写！！
Private Function NumstrToChinese(numstr As String) As String
Dim i As Integer, j As Integer
Dim mstrChar As String
Dim mstrFlag(4) As String
Dim mblnAddzero As Boolean

On Error Resume Next
mstrFlag(0) = Trim("")
mstrFlag(1) = Trim("T")
mstrFlag(2) = Trim("H")
mstrFlag(3) = Trim("S")

For i = 1 To Len(numstr)
j = Len(numstr) - i
mstrChar = Mid(numstr, i, 1)
If mstrChar <> "0" And j > 1 Then NumstrToChinese = NumstrToChinese + mstrChar + mstrFlag((j - 2) Mod 4)
If mstrChar = "0" And mblnAddzero = False Then
NumstrToChinese = NumstrToChinese + Trim("0")
mblnAddzero = True
End If
If j = 14 Then NumstrToChinese = NumstrToChinese + Trim("W")
If j = 2 Then
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then
NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1) + "Y0"
Else
NumstrToChinese = NumstrToChinese + "Y" '元
End If
End If
If j = 6 Then
If Len(NumstrToChinese) > 2 Then
If Mid(NumstrToChinese, Len(NumstrToChinese) - 1, 2) = "M0" Then GoTo 10
End If
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then
NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1) + "W0"
Else
NumstrToChinese = NumstrToChinese + "W"
End If
End If
10:
If j = 10 Then
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then
NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1) + "M0"
Else
NumstrToChinese = NumstrToChinese + "M" '亿
End If
End If
If j = 0 And mstrChar <> "0" Then NumstrToChinese = NumstrToChinese + mstrChar + "F"
If j = 1 And mstrChar <> "0" Then NumstrToChinese = NumstrToChinese + mstrChar + "J"
If mstrChar <> "0" Then mblnAddzero = False
Next i
If Mid(NumstrToChinese, 1, 1) = "1" And Mid(NumstrToChinese, 2, 1) = mstrFlag(1) Then NumstrToChinese = Mid(NumstrToChinese, 2, Len(NumstrToChinese) - 1)
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "0" Then NumstrToChinese = Mid(NumstrToChinese, 1, Len(NumstrToChinese) - 1)
If Mid(NumstrToChinese, 1, 1) = "0" Then NumstrToChinese = Mid(NumstrToChinese, 2, Len(NumstrToChinese) - 1)
If Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "M" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "W" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "S" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "H" Or Mid(NumstrToChinese, Len(NumstrToChinese), 1) = "T" Then NumstrToChinese = NumstrToChinese + Trim("Y")
End Function