13518219792
Private Sub Text2_Change() '大写金额转换成阿拉伯数字金额
创新互联提供高防服务器、云服务器、香港服务器、成都多线服务器托管等
Dim i As Integer
Dim j As Integer
Dim myint As Integer
Dim myint1 As Integer
Dim mydoub As Double
Dim mystr As String
Dim mystr1 As String
Dim mystr2 As String
Dim mystr3 As String
Dim mystr4 As String
Dim money As Long
Dim money1 As Integer
Dim money2 As Long
mystr = Text2.Text
myint = InStr(mystr, ".")
If myint = 0 Then
mystr = Text2.Text
Else
mystr3 = Right(Text2.Text, Len(Text2.Text) - myint)
If mystr3 "" Then '转换小数位
mystr4 = Left(mystr3, 1)
mystr3 = Right(mystr3, Len(mystr3) - 1)
If mystr4 "0" Then
mystr2 = mystr2 + setdata(Val(mystr4)) + "角"
End If
If mystr3 "" Then
mystr4 = Left(mystr3, 1)
mystr2 = mystr2 + setdata(Val(mystr4)) + "分"
End If
End If
mystr = Left(Text2.Text, myint - 1)
End If
j = Len(mystr)
For i = 1 To Len(mystr) '转换整数位
money2 = Left(mystr, i)
money1 = Right(money2, 1)
If money1 = 0 Then
If j = 5 Then
If Right(mystr1, 1) "万" Then mystr1 = mystr1 "万"
Else
If Right(mystr1, 1) "零" And Right(money, j) 0 Then mystr1 = mystr1 "零"
End If
Else
mystr1 = mystr1 setdata(money1) + chang(j)
End If
j = j - 1
Next i
Text1.Text = mystr1 "元" mystr2 '显示大写
End Sub
转自
将阿拉伯数字转换为汉字数字,支持到百万亿(比如大写金额)
例子:
Debug.Print UpNumber(-612325646566.46,0,True )
负陆仟壹佰贰拾叁亿贰仟伍佰陆拾肆万陆仟伍佰陆拾陆圆肆角陆分
Debug.Print UpNumber(-125646566.46,1,True )
负一亿二千五百六十四万六千五百六十六元四角六分
Debug.Print UpNumber(-125646566.46,1,flase )
负一亿二千五百六十四万六千五百六十六点四六
Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String
'********************************************************************************
'--------------------------------------------------------------------------------
'将阿拉伯数字转换为大写字符串
'--------------------------------------------------------------------------------
'参数说明:
'Number 待转换的数字,可以是小数.
'Typ 转换类型,可选值 0,1
'0 转换为 零,壹,贰 等
'1 转换为 一,二,三 等
'IsMoney 是否是金额,如果是,则转换为多少元,小数后转换为多少角,分,反之则转换为类似于"二点三"这种形式
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'返回值说明:
'如果成功,返回转换后的字符串
'如果失败,返回空字符串
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'注意,由于 Double 类型数值范围的原因,此函数最大只支持到百万亿
'没有对 Typ 的值进行检查,如果 Typ 不为 0,1 之一,将会引发错误.
'另,由于 Double 类型数值范围的原因,超过百万亿,将不能显示小数,同样的超过十万亿只能显示一个小数,以此类推.
'--------------------------------------------------------------------------------
'********************************************************************************
On Error GoTo Doerr
Dim Result As String '返回值
Dim strNumber As String '文本型的 Number
Dim lngNumberLen As Long '文本型的 Number 的 Len
Dim strTmp As String
Dim strFirst As String, strEnd As String
Dim lngI As Long, lngJ As Long, lngTmp As Long
Dim strNum(10) As String '大写数字
Dim strUnit(16) As String '单位,比如 十,拾,万等
Dim strUnitB(2) As String '小数后的单位
'初始化
Select Case Typ
Case 0
strNum(0) = "零": strNum(1) = "壹": strNum(2) = "贰": strNum(3) = "叁"
strNum(4) = "肆": strNum(5) = "伍": strNum(6) = "陆": strNum(7) = "柒"
strNum(8) = "捌": strNum(9) = "玖"
If IsMoney Then
strUnit(0) = "圆"
strUnitB(0) = "角": strUnitB(1) = "分"
Else
strUnit(0) = "点"
End If
strUnit(1) = "拾": strUnit(2) = "佰": strUnit(3) = "仟": strUnit(4) = "万"
strUnit(5) = "拾": strUnit(6) = "佰": strUnit(7) = "仟": strUnit(8) = "亿"
strUnit(9) = "拾": strUnit(10) = "佰": strUnit(11) = "仟": strUnit(12) = "万"
strUnit(13) = "拾": strUnit(14) = "佰": strUnit(15) = "仟"
Case 1
strNum(0) = "零": strNum(1) = "一": strNum(2) = "二": strNum(3) = "三"
strNum(4) = "四": strNum(5) = "五": strNum(6) = "六": strNum(7) = "七"
strNum(8) = "八": strNum(9) = "九"
If IsMoney Then
strUnit(0) = "元"
strUnitB(0) = "角": strUnitB(1) = "分"
Else
strUnit(0) = "点"
End If
strUnit(1) = "十": strUnit(2) = "百": strUnit(3) = "千": strUnit(4) = "万"
strUnit(5) = "十": strUnit(6) = "百": strUnit(7) = "千": strUnit(8) = "亿"
strUnit(9) = "十": strUnit(10) = "百": strUnit(11) = "千": strUnit(12) = "万"
strUnit(13) = "十": strUnit(14) = "百": strUnit(15) = "千"
Case Else
'参数错误
GoTo Errexit
End Select
Result = ""
If Number = 0 Then
If IsMoney Then
Result = strNum(0) strUnit(0) "整"
Else
Result = strNum(0)
End If
Else
If IsMoney Then
strNumber = Trim(str(FormatCurrency(Number, 2, vbTrue, vbFalse, vbFalse))) '保留两位小数
Else
strNumber = Trim(str(Number)) '简单的转换为字符串型
End If
lngNumberLen = Len(strNumber)
If Left(strNumber, 1) = "-" Then '处理负数
strFirst = "负"
strNumber = Right(strNumber, lngNumberLen - 1)
lngNumberLen = lngNumberLen - 1
Else
strFirst = "" '通常不需要 =""
End If
lngI = InStrRev(strNumber, ".")
If lngI Then
strTmp = Right(strNumber, lngNumberLen - lngI)
If IsMoney Then
strTmp = strTmp "00"
strEnd = "" '通常不需要 =""
For lngJ = 1 To 2
Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1))) strUnitB(lngJ - 1)
Next
Else
strTmp = Right(strNumber, lngNumberLen - lngI)
For lngJ = 1 To lngNumberLen - lngI
Result = Result strNum(CLng(Mid$(strTmp, lngJ, 1)))
Next
End If
strNumber = Left(strNumber, lngI - 1) '去除小数部分
lngNumberLen = Len(strNumber) '新的字符串长度
Else
If IsMoney Then
strEnd = "整"
Else
strEnd = ""
End If
End If
'以下为主循环部分
lngI = 0
For lngJ = lngNumberLen To 1 Step -1
lngTmp = CLng(Mid$(strNumber, lngJ, 1))
If lngTmp Then
Result = strNum(lngTmp) strUnit(lngI) Result
Else
If lngI = 0 Or lngI = 4 Or lngI = 8 Or lngI = 12 Then '超过 16 位不支持
Result = strNum(lngTmp) strUnit(lngI) Result
Else
Result = strNum(lngTmp) Result
End If
End If
lngI = lngI + 1
Next
Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零
Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零
'亿零万零圆", "亿圆"
Result = Replace(Result, strUnit(8) strNum(0) strUnit(4) strNum(0) strUnit(0), strUnit(8) strUnit(0))
Result = Replace(Result, strUnit(8) strNum(0) strUnit(4), strUnit(8) strNum(0)) '亿零万, "亿零"
Result = Replace(Result, strUnit(4) strNum(0) strUnit(0), strUnit(4) strUnit(0)) '亿零万", "亿零
Result = Replace(Result, strNum(0) strUnit(8), strUnit(8)) '零亿
Result = Replace(Result, strNum(0) strUnit(4), strUnit(4)) '零万
Result = Replace(Result, strNum(0) strUnit(0), strUnit(0)) '零圆
Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零
Result = Replace(Result, strNum(0) strNum(0), strNum(0)) '零零", "零
If IsMoney Then
Result = strFirst Result strEnd
Else
Result = strFirst Result
If Right(Result, 1) = strUnit(0) Then Result = Left(Result, Len(Result) - 1) '去除最后一个 "点"
End If
End If
Complete:
GoTo Quit
Doerr:
Errexit:
Result = ""
Quit:
UpNumber = Result
End Function
这个vb是没有现成的函数的，给你一个函数你参考下：
Public Function ConvToMoney(ByVal Digital As String) As String
Dim strChi(11), strDig(10) As String
Dim sTmp, rsStr As String
Dim lenStr As Byte
Dim laststr As String
If Not IsNumeric(Digital) Then
ConvToMoney = ""
Exit Function
End If
If Val(Format(Digital)) 0 Then
Digital = Trim(Str(Abs(Val(Format(Digital)))))
laststr = "整(负)"
Else
laststr = "整"
End If
strChi(0) = "分"
strChi(1) = "角"
strChi(2) = "元"
strChi(3) = "拾"
strChi(4) = "佰"
strChi(5) = "仟"
strChi(6) = "万"
strChi(7) = "拾"
strChi(8) = "佰"
strChi(9) = "仟"
strChi(10) = "亿"
strDig(0) = "零"
strDig(1) = "壹"
strDig(2) = "贰"
strDig(3) = "叁"
strDig(4) = "肆"
strDig(5) = "伍"
strDig(6) = "陆"
strDig(7) = "柒"
strDig(8) = "捌"
strDig(9) = "玖"
sTmp = Digital
If (Len(sTmp) = 0) Or (Len(sTmp) 11) Then
ConvToMoney = ""
Exit Function
End If
sTmp = Format(sTmp, "########.00")
If Len(sTmp) 11 Then
ConvToMoney = ""
Exit Function
End If
lenStr = Len(sTmp)
rsStr = strDig(Val(MID(sTmp, lenStr - 1, 1))) strChi(1) strDig(Val(Right(sTmp, 1))) strChi(0)
sTmp = Left(sTmp, Len(sTmp) - 3)
Dim i, d As Byte
Dim blnZero As Boolean
Dim stmprv, dstr As String
For i = 1 To Len(sTmp)
stmprv = MID(sTmp, i, 1) stmprv
Next
For i = 1 To Len(stmprv)
d = Val(MID(stmprv, i, 1))
If d = 0 Then
If i = 1 Or i = 5 Then
dstr = strChi(i + 1)
Else
If Not blnZero Then
dstr = strDig(0)
Else
dstr = ""
End If
End If
blnZero = True
Else
dstr = strDig(d) strChi(i + 1)
blnZero = False
End If
rsStr = dstr + rsStr
Next
ConvToMoney = rsStr laststr
End Function
