欧美日韩高清国产,99久久无码一区人妻a黑,久久精品女人天堂

當(dāng)前位置：主頁 > 技巧 > Access技巧 > 模塊函數(shù)VBA > 正文

Access人民幣大寫

時(shí)間：2005-08-16 10:45 來源：未知作者：共享閱讀：次

Private Function Num2Char(ByVal I As Integer) As String 將小寫數(shù)字轉(zhuǎn)為大寫數(shù)字
If I >= 0 And I <= 9 Then
Num2Char = Mid$("零壹貳叁肆伍陸柒捌玖", I + 1, 1)
Else
Num2Char = ""
End If
End Function

Private Function Num2RMB(ByVal sFourBitString As String, Optional _
ByVal sUnit As String = "元", Optional ByVal bMustHeader As _
Boolean = False) As String 階段變換(個(gè)位至千位,萬位至千萬位,億位至千億位)中的大寫處理
會出現(xiàn)的問題:個(gè)位,萬位,億位為0時(shí)大寫不加零,階段中全為0時(shí)不加零.問題在后面修正.
Dim vNum, I, RX, BR, hdr, bNum
BR = "仟佰拾元"
vNum = Trim(Str(Val(sFourBitString))) 返回有效字符串,最多四位
bNum = vNum
If (Len(vNum) < 4 And Len(vNum) > 0) And bMustHeader Then hdr = "零" Else hdr = ""
RX = ""
Do While Len(vNum) > 0
I = Right(vNum, 1)
If I > 0 Then
RX = Num2Char(I) + Right(BR, 1) + RX
Else
If Left(RX, 1) <> "零" Then RX = "零" + RX
End If
vNum = Left(vNum, Len(vNum) - 1)
BR = Left(BR, Len(BR) - 1)
Loop
RX = Left(RX, Len(RX) - 1)
If Right(RX, 1) = "零" Then 去除多余的零
RX = Left(RX, Len(RX) - 1)
End If
If Len(RX) > 0 Then
Num2RMB = hdr + RX + sUnit
Else
Num2RMB = RX + IIf(sUnit = "元", "元", "")
End If
★ 修正個(gè)位,萬位,億位為0時(shí)大寫不加零的問題.如:"20.5"會寫作"貳拾元(零)伍角整","208000"會寫作"貳拾萬(零)捌仟元整".
會出現(xiàn)的問題:大寫中會出現(xiàn)重復(fù)零,結(jié)尾"整"或"元整"前會出現(xiàn)多余的零.問題會在代碼結(jié)尾處修正.
If Len(bNum) > 1 And Right(bNum, 1) = 0 Then
Num2RMB = Num2RMB + "零"
End If
★
End Function

Function GetDXJE(ByVal Num As Currency) As String 得到大寫金額
Dim vNum, vDec, ret, qb, js, s
vNum = Right(Format$(Int(Num), "000000000000"), 12) 取十二位整數(shù)
vDec = Right(Format$(Int(Num * 100 + 0.5), "00"), 2) 取小數(shù)點(diǎn)后兩位并自動(dòng)四舍五入
ret = Num2RMB(Left(vNum, 4), "億", False)
If Len(ret) = 0 Then
ret = Num2RMB(Mid(vNum, 5, 4), "萬", False)
Else
ret = ret + Num2RMB(Mid(vNum, 5, 4), "萬", True)
★ 修正萬位至千萬位階段中全為0時(shí)不加零的問題,如:"800008000"會寫作"捌億(零)捌仟元整".
會出現(xiàn)多余零的問題,如:"800000000"會寫作"捌億零元整".
If Mid(vNum, 5, 1) = 0 And Mid(vNum, 6, 1) = 0 And Mid(vNum, 7, 1) = 0 And Mid(vNum, 8, 1) = 0 Then
ret = ret + "零"
End If
★
End If
If Len(ret) = 0 Then
ret = Num2RMB(Right(vNum, 4), "元", False)
Else
ret = ret + Num2RMB(Right(vNum, 4), "元", True)
★ 修正個(gè)位至千位階段中全為0時(shí)不加零的問題,如:"80000.1"會寫作"捌萬元(零)壹角整".
會出現(xiàn)多余零的問題.
If Mid(vNum, 9, 1) = 0 And Mid(vNum, 10, 1) = 0 And Mid(vNum, 11, 1) = 0 And Mid(vNum, 12, 1) = 0 Then
ret = ret + "零"
End If
★
End If
If ret = "元" Then
ret = ""
qb = ""
Else
qb = "xx"
End If
If vDec = "00" And qb <> "" Then 1.00
ret = ret + "整"
End If
If vDec = "00" And qb = "" Then 0.00
ret = "零"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) = 0 And qb <> "" Then 1.20
ret = ret + Num2Char(Left(vDec, 1)) + "角整"
End If
If Left(vDec, 1) = "0" And Right(vDec, 1) <> 0 And qb <> "" Then 1.03
ret = ret + "零" + Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) <> 0 And qb <> "" Then 1.23
ret = ret + Num2Char(Left(vDec, 1)) + "角" + Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) = 0 And qb = "" Then 0.20
ret = Num2Char(Left(vDec, 1)) + "角整"
End If
If Left(vDec, 1) = "0" And Right(vDec, 1) <> 0 And qb = "" Then 0.03
ret = Num2Char(Right(vDec, 1)) + "分"
End If
If Left(vDec, 1) <> "0" And Right(vDec, 1) <> 0 And qb = "" Then 0.23
ret = Num2Char(Left(vDec, 1)) + "角" + Num2Char(Right(vDec, 1)) + "分"
End If
★修正大寫中出現(xiàn)重復(fù)零的問題.如:"800800"會寫作"捌拾萬零零捌佰元整".
修正大寫"元"前出現(xiàn)多余零的問題.如:"800000.1"會寫作"捌拾萬零元整零壹角整".
修正大寫結(jié)尾"整"前出現(xiàn)多余零的問題.如:"200"會寫作"貳佰元零整".
js = 0
Do While js <> Len(ret)
js = Len(ret)
For s = 2 To Len(ret) - 1
If Mid(ret, s, 1) = "零" Then
If Mid(ret, s + 1, 1) = "零" Or Mid(ret, s + 1, 1) = "元" Or Mid(ret, s + 1, 1) = "整" Then
ret = Left(ret, s - 1) + Right(ret, Len(ret) - s)
Exit For
End If
End If
Next
Loop
★
GetDXJE = ret
End Function