谁有现存的把价格转换为大写人民币输出的函数?
有的话给我一个好吗?
应该不是太难,但要写好还是有点复杂的.所以想问大家要一个啦.
比如:
1234.56
转换为:
壹仟贰佰叁拾肆元伍角陆分整

Private Function cch(N1) As String '中文大写辅助部分
cch = Mid("零壹贰叁肆伍陆柒捌玖", N1 + 1, 1)
End Function

Public Function ChMoney(N1) As String '中文大写
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000

If N1 = "" Then N1 = 0

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

'可以圆+整的形式，及处理 0.01 - 0.09分之间
If Right(str(N1), 3) <= ".09" And Right(str(N1), 3) >= ".01" Then
ChMoney = Replace(IIf(Right(str(N1 * 100), 2) = "00", IIf(s3 & s2 = "", s1, s3 & s2 & "圆" & s1) & "整", IIf(s3 & s2 = "", s1, s3 & s2 & "圆" & s1)), "圆", "圆零")
Else
ChMoney = IIf(Right(str(N1 * 100), 2) = "00", IIf(s3 & s2 = "", s1, s3 & s2 & "圆" & s1) & "整", IIf(s3 & s2 = "", s1, s3 & s2 & "圆" & s1))
End If
End Function

msgbox chmoney(121333.25)

谢谢!!
你的好完整
我刚自己写了一个:
m = Text1.Text
If IsNumeric(m) Then
m = Format(m, "#0.00")
m1 = CStr(m)
For n = 1 To Len(m1)
a = Mid(m1, n, 1)
If a = "." Then
m = Val(Left(m1, n - 1))
mm = Val(Right(m1, Len(m1) - n))
End If
Next
For n = 1 To Len(CStr(m))
a = Mid(m1, n, 1)
aa = Mid("零壹贰叁肆伍陆柒捌玖", Val(a) + 1, 1)
bb = Mid("元拾佰仟万拾佰仟亿拾佰仟", Len(CStr(m)) - n + 1, 1)
xx = xx & aa & bb
Next
For n = 1 To 2
a = Mid(CStr(mm), n, 1)
aa = Mid("零壹贰叁肆伍陆柒捌玖", Val(a) + 1, 1)
bb = Mid("角分", n, 1)
xx = xx & aa & bb
Next
MsgBox xx
Else
MsgBox "请输入数值型!"
End If

我的简单一点,不过不符合书写习惯,因为我的会出现
壹佰零拾贰万零仟零佰零拾零元零角零分
习惯应该为:
壹佰零贰万元整
不过我的还算符合国家规定的《正确填写票据和结算凭证的基本规定》
有一点我不明白:我看有好多都用圆,你的程序也用圆,但《正确填写票据和结算凭证的基本规定》中规定用元.
不过它有一点说明说:繁体的也可以,不知道这个圆是不是元的繁体?