Private Sub Text2_Change() '大寫金額轉(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) "萬" 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
轉(zhuǎn)自
將阿拉伯?dāng)?shù)字轉(zhuǎn)換為漢字?jǐn)?shù)字,支持到百萬億(比如大寫金額)
例子:
Debug.Print UpNumber(-612325646566.46,0,True )
負(fù)陸仟壹佰貳拾叁億貳仟伍佰陸拾肆萬陸仟伍佰陸拾陸圓肆角陸分
Debug.Print UpNumber(-125646566.46,1,True )
負(fù)一億二千五百六十四萬六千五百六十六元四角六分
Debug.Print UpNumber(-125646566.46,1,flase )
負(fù)一億二千五百六十四萬六千五百六十六點四六
Public Function UpNumber(ByVal Number As Double, Optional ByVal Typ As Long, Optional ByVal IsMoney As Boolean) As String
'********************************************************************************
'--------------------------------------------------------------------------------
'將阿拉伯?dāng)?shù)字轉(zhuǎn)換為大寫字符串
'--------------------------------------------------------------------------------
'參數(shù)說明:
'Number 待轉(zhuǎn)換的數(shù)字,可以是小數(shù).
'Typ 轉(zhuǎn)換類型,可選值 0,1
'0 轉(zhuǎn)換為 零,壹,貳 等
'1 轉(zhuǎn)換為 一,二,三 等
'IsMoney 是否是金額,如果是,則轉(zhuǎn)換為多少元,小數(shù)后轉(zhuǎn)換為多少角,分,反之則轉(zhuǎn)換為類似于"二點三"這種形式
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'返回值說明:
'如果成功,返回轉(zhuǎn)換后的字符串
'如果失敗,返回空字符串
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'注意,由于 Double 類型數(shù)值范圍的原因,此函數(shù)最大只支持到百萬億
'沒有對 Typ 的值進(jìn)行檢查,如果 Typ 不為 0,1 之一,將會引發(fā)錯誤.
'另,由于 Double 類型數(shù)值范圍的原因,超過百萬億,將不能顯示小數(shù),同樣的超過十萬億只能顯示一個小數(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 '大寫數(shù)字
Dim strUnit(16) As String '單位,比如 十,拾,萬等
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) = "點"
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
'參數(shù)錯誤
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)) '簡單的轉(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) '新的字符串長度
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 '超過 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是沒有現(xiàn)成的函數(shù)的,給你一個函數(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) = "萬"
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)大室的簡單介紹
標(biāo)題來源:http://muchs.cn/article46/hgsphg.html
成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián),為您提供虛擬主機(jī)、響應(yīng)式網(wǎng)站、全網(wǎng)營銷推廣、面包屑導(dǎo)航、軟件開發(fā)、服務(wù)器托管
聲明:本網(wǎng)站發(fā)布的內(nèi)容(圖片、視頻和文字)以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主,如果涉及侵權(quán)請盡快告知,我們將會在第一時間刪除。文章觀點不代表本網(wǎng)站立場,如需處理請聯(lián)系客服。電話:028-86922220;郵箱:631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載,或轉(zhuǎn)載時需注明來源: 創(chuàng)新互聯(lián)