Private Function Num2Char(ByVal I As Integer) As String 将小写数字转为大写数字 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 阶段变换(个位至千位,万位至千万位,亿位至千亿位)中的大写处理 会出现的问题:个位,万位,亿位为0时大写不加零,阶段中全为0时不加零.问题在后面修正. 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 ★ 修正个位,万位,亿位为0时大写不加零的问题.如:"20.5"会写作"贰拾元(零)伍角整","208000"会写作"贰拾万(零)捌仟元整". 会出现的问题:大写中会出现重复零,结尾"整"或"元整"前会出现多余的零.问题会在代码结尾处修正. 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) 取十二位整数 vDec = Right(Format$(Int(Num * 100 + 0.5), "00"), 2) 取小数点后两位并自动四舍五入 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时不加零的问题,如:"800008000"会写作"捌亿(零)捌仟元整". 会出现多余零的问题,如:"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) ★ 修正个位至千位阶段中全为0时不加零的问题,如:"80000.1"会写作"捌万元(零)壹角整". 会出现多余零的问题. 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 ★修正大写中出现重复零的问题.如:"800800"会写作"捌拾万零零捌佰元整". 修正大写"元"前出现多余零的问题.如:"800000.1"会写作"捌拾万零元整零壹角整". 修正大写结尾"整"前出现多余零的问题.如:"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
|