给你一段我写的程序,很不错的,记得加分哦! Dim CHAp(21, 1) 初始化: CHAp(0, 0) = "万": CHAp(0, 1) = 10000 CHAp(1, 0) = "仟": CHAp(1, 1) = 1000 CHAp(2, 0) = "佰": CHAp(2, 1) = 100 CHAp(3, 0) = "拾": CHAp(3, 1) = 10 CHAp(4, 0) = "元": CHAp(4, 1) = 1 CHAp(5, 0) = "角": CHAp(5, 1) = 0.1 CHAp(6, 0) = "分": CHAp(6, 1) = 0.01 CHAp(11, 0) = "壹": CHAp(11, 1) = 1 CHAp(12, 0) = "贰": CHAp(12, 1) = 2 CHAp(13, 0) = "叁": CHAp(13, 1) = 3 CHAp(14, 0) = "肆": CHAp(14, 1) = 4 CHAp(15, 0) = "伍": CHAp(15, 1) = 5 CHAp(16, 0) = "陆": CHAp(16, 1) = 6 CHAp(17, 0) = "柒": CHAp(17, 1) = 7 CHAp(18, 0) = "捌": CHAp(18, 1) = 8 CHAp(19, 0) = "玖": CHAp(19, 1) = 9 CHAp(20, 0) = "零": CHAp(20, 1) = 0 CHAp(21, 0) = "亿": CHAp(21, 1) = 100000000Function SubtoChinese(price As Integer) '转化千百十 Dim i As Integer Dim num(15) As Integer i = 1 Do Until price = 0 num(i) = Int(price / CHAp(i, 1)) If num(i) <> 0 Then SubtoChinese = SubtoChinese & CHAp(num(i) + 10, 0) & CHAp(i, 0) price = price - num(i) * CHAp(i, 1) Else If SubtoChinese <> "" And Right(SubtoChinese, 1) <> "零" Then SubtoChinese = SubtoChinese & "零" End If End If i = i + 1 Loop If Right(SubtoChinese, 1) = "元" Then SubtoChinese = Left(SubtoChinese, Len(SubtoChinese) - 1) End If End FunctionFunction PricetoChinese(price As Double) If price >= 100000000 Then '大于1亿 PricetoChinese = PricetoChinese & PricetoChinese(Int(price / 100000000)) & "亿" price = price - Int(price / 100000000) * 100000000 End If If price >= 10000 Then PricetoChinese = PricetoChinese & SubtoChinese(Int(price / 10000)) & "万" price = price - Int(price / 10000) * 10000 End If If Int(price) <> 0 Then '如果万与千间无数,则应添零 If PricetoChinese <> "" And Int(price) < 1000 Then PricetoChinese = PricetoChinese & "零" End If PricetoChinese = PricetoChinese & SubtoChinese(Int(price)) price = price - Int(price) End If If PricetoChinese <> "" Then PricetoChinese = PricetoChinese & "元" If price = 0 Then '到元为止 PricetoChinese = PricetoChinese & "整" Else price = Int(price * 100) If Int(price / 10) <> 0 Then PricetoChinese = PricetoChinese & CHAp(Int(price / 10) + 10, 0) & "角" price = price - Int(price / 10) * 10 End If If price <> 0 Then PricetoChinese = PricetoChinese & CHAp(Int(price) + 10, 0) & "分"
End If End If End Function 调用时:PricetoChinese(123432435.345)
给你个现成的函数,把分给我吧 :) Public Function ChiAmt(ByVal intAmount As Currency) As String '*********************************************************************** '* 此函数用于返回中文格式的金额,如:壹佰叁拾元整。 '*********************************************************************** Dim strSource, strTarget As String Dim intMaxLen, intOldSelect As Integer Dim String1, String2, strCCYDsp As String Dim intPointer As IntegerintAmount = Format(Abs(Round(intAmount, 2)), "#0.00")strTarget = "人民币"
If intAmount = 0 Then ChiAmt = strTarget & "零元整" Exit Function End If ' 太大的数无法处理 If intAmount > 999999999999.99 Then ChiAmt = strTarget & "********************************元" Exit Function End If intMaxLen = 15 String1 = "壹贰叁肆伍陆柒捌玖" String2 = "仟佰拾亿仟佰拾万仟佰拾元角分" strSource = CStr(Format(intAmount, "#0.00")) intPointer = intMaxLen - Len(strSource) '获得空格数 strSource = Space(intPointer) & Left(strSource, Len(strSource) - 3) & Right(strSource, 2) ' 去掉小数点,整数部分不够12位时补空格 For i = intPointer + 1 To intMaxLen - 1 If Mid(strSource, i, 1) <> "0" Then strTarget = strTarget & Mid(String1, Val(Mid(strSource, i, 1)), 1) & Mid(String2, i, 1) Else If i <> 4 And i <> 8 And i <> 12 Then strTarget = IIf(Right(strTarget, 1) = "零", strTarget, strTarget & "零") Else If i = 12 Then strTarget = IIf(Right(strTarget, 1) = "零", Mid(strTarget, 1, Len(strTarget) - 1) & "元", strTarget & "零元") Else strTarget = IIf(Right(strTarget, 1) = "零", Mid(strTarget, 1, Len(strTarget) - 1) & Mid(String2, i, 1), strTarget & Mid(String2, i, 1)) End If End If End If Next istrTarget = IIf(Right(strTarget, 1) = "零", Mid(strTarget, 1, Len(strTarget) - 1), strTarget) strTarget = strTarget & IIf(Right(strSource, 1) = "0", "整", "")If intAmount <> 0 Then strTarget = Replace(strTarget, "零元", "元") End IfChiAmt = strTargetEnd Function
Dim CHAp(21, 1)
初始化: CHAp(0, 0) = "万": CHAp(0, 1) = 10000
CHAp(1, 0) = "仟": CHAp(1, 1) = 1000
CHAp(2, 0) = "佰": CHAp(2, 1) = 100
CHAp(3, 0) = "拾": CHAp(3, 1) = 10
CHAp(4, 0) = "元": CHAp(4, 1) = 1
CHAp(5, 0) = "角": CHAp(5, 1) = 0.1
CHAp(6, 0) = "分": CHAp(6, 1) = 0.01
CHAp(11, 0) = "壹": CHAp(11, 1) = 1
CHAp(12, 0) = "贰": CHAp(12, 1) = 2
CHAp(13, 0) = "叁": CHAp(13, 1) = 3
CHAp(14, 0) = "肆": CHAp(14, 1) = 4
CHAp(15, 0) = "伍": CHAp(15, 1) = 5
CHAp(16, 0) = "陆": CHAp(16, 1) = 6
CHAp(17, 0) = "柒": CHAp(17, 1) = 7
CHAp(18, 0) = "捌": CHAp(18, 1) = 8
CHAp(19, 0) = "玖": CHAp(19, 1) = 9
CHAp(20, 0) = "零": CHAp(20, 1) = 0
CHAp(21, 0) = "亿": CHAp(21, 1) = 100000000Function SubtoChinese(price As Integer)
'转化千百十
Dim i As Integer
Dim num(15) As Integer
i = 1
Do Until price = 0
num(i) = Int(price / CHAp(i, 1))
If num(i) <> 0 Then
SubtoChinese = SubtoChinese & CHAp(num(i) + 10, 0) & CHAp(i, 0)
price = price - num(i) * CHAp(i, 1)
Else
If SubtoChinese <> "" And Right(SubtoChinese, 1) <> "零" Then
SubtoChinese = SubtoChinese & "零"
End If
End If
i = i + 1
Loop
If Right(SubtoChinese, 1) = "元" Then
SubtoChinese = Left(SubtoChinese, Len(SubtoChinese) - 1)
End If
End FunctionFunction PricetoChinese(price As Double)
If price >= 100000000 Then '大于1亿
PricetoChinese = PricetoChinese & PricetoChinese(Int(price / 100000000)) & "亿"
price = price - Int(price / 100000000) * 100000000
End If
If price >= 10000 Then
PricetoChinese = PricetoChinese & SubtoChinese(Int(price / 10000)) & "万"
price = price - Int(price / 10000) * 10000
End If
If Int(price) <> 0 Then '如果万与千间无数,则应添零
If PricetoChinese <> "" And Int(price) < 1000 Then
PricetoChinese = PricetoChinese & "零"
End If
PricetoChinese = PricetoChinese & SubtoChinese(Int(price))
price = price - Int(price)
End If
If PricetoChinese <> "" Then PricetoChinese = PricetoChinese & "元"
If price = 0 Then '到元为止
PricetoChinese = PricetoChinese & "整"
Else
price = Int(price * 100)
If Int(price / 10) <> 0 Then
PricetoChinese = PricetoChinese & CHAp(Int(price / 10) + 10, 0) & "角"
price = price - Int(price / 10) * 10
End If
If price <> 0 Then
PricetoChinese = PricetoChinese & CHAp(Int(price) + 10, 0) & "分"
End If
End If
End Function
调用时:PricetoChinese(123432435.345)
Public Function ChiAmt(ByVal intAmount As Currency) As String
'***********************************************************************
'* 此函数用于返回中文格式的金额,如:壹佰叁拾元整。
'***********************************************************************
Dim strSource, strTarget As String
Dim intMaxLen, intOldSelect As Integer
Dim String1, String2, strCCYDsp As String
Dim intPointer As IntegerintAmount = Format(Abs(Round(intAmount, 2)), "#0.00")strTarget = "人民币"
If intAmount = 0 Then
ChiAmt = strTarget & "零元整"
Exit Function
End If
' 太大的数无法处理
If intAmount > 999999999999.99 Then
ChiAmt = strTarget & "********************************元"
Exit Function
End If
intMaxLen = 15
String1 = "壹贰叁肆伍陆柒捌玖"
String2 = "仟佰拾亿仟佰拾万仟佰拾元角分"
strSource = CStr(Format(intAmount, "#0.00"))
intPointer = intMaxLen - Len(strSource) '获得空格数
strSource = Space(intPointer) & Left(strSource, Len(strSource) - 3) & Right(strSource, 2) ' 去掉小数点,整数部分不够12位时补空格
For i = intPointer + 1 To intMaxLen - 1
If Mid(strSource, i, 1) <> "0" Then
strTarget = strTarget & Mid(String1, Val(Mid(strSource, i, 1)), 1) & Mid(String2, i, 1)
Else
If i <> 4 And i <> 8 And i <> 12 Then
strTarget = IIf(Right(strTarget, 1) = "零", strTarget, strTarget & "零")
Else
If i = 12 Then
strTarget = IIf(Right(strTarget, 1) = "零", Mid(strTarget, 1, Len(strTarget) - 1) & "元", strTarget & "零元")
Else
strTarget = IIf(Right(strTarget, 1) = "零", Mid(strTarget, 1, Len(strTarget) - 1) & Mid(String2, i, 1), strTarget & Mid(String2, i, 1))
End If
End If
End If
Next istrTarget = IIf(Right(strTarget, 1) = "零", Mid(strTarget, 1, Len(strTarget) - 1), strTarget)
strTarget = strTarget & IIf(Right(strSource, 1) = "0", "整", "")If intAmount <> 0 Then
strTarget = Replace(strTarget, "零元", "元")
End IfChiAmt = strTargetEnd Function