Private Sub Text2_Change() '大寫(xiě)金額轉(zhuǎn)換成阿拉伯?dāng)?shù)字金額
創(chuàng)新互聯(lián)提供高防服務(wù)器、云服務(wù)器、香港服務(wù)器、成都多線服務(wù)器托管等
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 '轉(zhuǎn)換小數(shù)位
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) '轉(zhuǎn)換整數(shù)位
money2 = Left(mystr, i)
money1 = Right(money2, 1)
If money1 = 0 Then
If j = 5 Then
If Right(mystr1, 1) "萬(wàn)" Then mystr1 = mystr1 "萬(wàn)"
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 '顯示大寫(xiě)
End Sub
轉(zhuǎn)自
將阿拉伯?dāng)?shù)字轉(zhuǎn)換為漢字?jǐn)?shù)字,支持到百萬(wàn)億(比如大寫(xiě)金額)
例子:
Debug.Print UpNumber(-612325646566.46,0,True )
負(fù)陸仟壹佰貳拾叁億貳仟伍佰陸拾肆萬(wàn)陸仟伍佰陸拾陸圓肆角陸分
Debug.Print UpNumber(-125646566.46,1,True )
負(fù)一億二千五百六十四萬(wàn)六千五百六十六元四角六分
Debug.Print UpNumber(-125646566.46,1,flase )
負(fù)一億二千五百六十四萬(wàn)六千五百六十六點(diǎn)四六
Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String
'********************************************************************************
'--------------------------------------------------------------------------------
'將阿拉伯?dāng)?shù)字轉(zhuǎn)換為大寫(xiě)字符串
'--------------------------------------------------------------------------------
'參數(shù)說(shuō)明:
'Number 待轉(zhuǎn)換的數(shù)字,可以是小數(shù).
'Typ 轉(zhuǎn)換類型,可選值 0,1
'0 轉(zhuǎn)換為 零,壹,貳 等
'1 轉(zhuǎn)換為 一,二,三 等
'IsMoney 是否是金額,如果是,則轉(zhuǎn)換為多少元,小數(shù)后轉(zhuǎn)換為多少角,分,反之則轉(zhuǎn)換為類似于"二點(diǎn)三"這種形式
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'返回值說(shuō)明:
'如果成功,返回轉(zhuǎn)換后的字符串
'如果失敗,返回空字符串
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'注意,由于 Double 類型數(shù)值范圍的原因,此函數(shù)最大只支持到百萬(wàn)億
'沒(méi)有對(duì) Typ 的值進(jìn)行檢查,如果 Typ 不為 0,1 之一,將會(huì)引發(fā)錯(cuò)誤.
'另,由于 Double 類型數(shù)值范圍的原因,超過(guò)百萬(wàn)億,將不能顯示小數(shù),同樣的超過(guò)十萬(wàn)億只能顯示一個(gè)小數(shù),以此類推.
'--------------------------------------------------------------------------------
'********************************************************************************
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 '大寫(xiě)數(shù)字
Dim strUnit(16) As String '單位,比如 十,拾,萬(wàn)等
Dim strUnitB(2) As String '小數(shù)后的單位
'初始化
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) = "點(diǎn)"
End If
strUnit(1) = "拾": strUnit(2) = "佰": strUnit(3) = "仟": strUnit(4) = "萬(wàn)"
strUnit(5) = "拾": strUnit(6) = "佰": strUnit(7) = "仟": strUnit(8) = "億"
strUnit(9) = "拾": strUnit(10) = "佰": strUnit(11) = "仟": strUnit(12) = "萬(wàn)"
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) = "點(diǎn)"
End If
strUnit(1) = "十": strUnit(2) = "百": strUnit(3) = "千": strUnit(4) = "萬(wàn)"
strUnit(5) = "十": strUnit(6) = "百": strUnit(7) = "千": strUnit(8) = "億"
strUnit(9) = "十": strUnit(10) = "百": strUnit(11) = "千": strUnit(12) = "萬(wàn)"
strUnit(13) = "十": strUnit(14) = "百": strUnit(15) = "千"
Case Else
'參數(shù)錯(cuò)誤
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))) '保留兩位小數(shù)
Else
strNumber = Trim(str(Number)) '簡(jiǎn)單的轉(zhuǎn)換為字符串型
End If
lngNumberLen = Len(strNumber)
If Left(strNumber, 1) = "-" Then '處理負(fù)數(shù)
strFirst = "負(fù)"
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) '去除小數(shù)部分
lngNumberLen = Len(strNumber) '新的字符串長(zhǎng)度
Else
If IsMoney Then
strEnd = "整"
Else
strEnd = ""
End If
End If
'以下為主循環(huán)部分
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 '超過(guò) 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)) '零零", "零
'億零萬(wàn)零圓", "億圓"
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)) '億零萬(wàn), "億零"
Result = Replace(Result, strUnit(4) strNum(0) strUnit(0), strUnit(4) strUnit(0)) '億零萬(wàn)", "億零
Result = Replace(Result, strNum(0) strUnit(8), strUnit(8)) '零億
Result = Replace(Result, strNum(0) strUnit(4), strUnit(4)) '零萬(wàn)
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) '去除最后一個(gè) "點(diǎn)"
End If
End If
Complete:
GoTo Quit
Doerr:
Errexit:
Result = ""
Quit:
UpNumber = Result
End Function
這個(gè)vb是沒(méi)有現(xiàn)成的函數(shù)的,給你一個(gè)函數(shù)你參考下:
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 = "整(負(fù))"
Else
laststr = "整"
End If
strChi(0) = "分"
strChi(1) = "角"
strChi(2) = "元"
strChi(3) = "拾"
strChi(4) = "佰"
strChi(5) = "仟"
strChi(6) = "萬(wàn)"
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
標(biāo)題名稱:vb.net金額轉(zhuǎn)大室的簡(jiǎn)單介紹
標(biāo)題來(lái)源:http://chinadenli.net/article46/hgsphg.html
成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián),為您提供虛擬主機(jī)、響應(yīng)式網(wǎng)站、全網(wǎng)營(yíng)銷(xiāo)推廣、面包屑導(dǎo)航、軟件開(kāi)發(fā)、服務(wù)器托管
聲明:本網(wǎng)站發(fā)布的內(nèi)容(圖片、視頻和文字)以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主,如果涉及侵權(quán)請(qǐng)盡快告知,我們將會(huì)在第一時(shí)間刪除。文章觀點(diǎn)不代表本網(wǎng)站立場(chǎng),如需處理請(qǐng)聯(lián)系客服。電話:028-86922220;郵箱:631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載,或轉(zhuǎn)載時(shí)需注明來(lái)源: 創(chuàng)新互聯(lián)