|
在报表中如何使文本框的(大写)等于合计值
如:合计值为11690.00 大写应自动显示为壹万壹仟陆佰玖拾元整
雨后的天空 发表于 2009-2-23 15:59
给你找到了:
getdxje(你要转换的金额) 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 '---------------------------------------------------------------------- Dim vNum, I, RX, BR, hdr '------------------------------------------------------------------ BR = "仟佰拾元" '------------------------------------------------------------------ vNum = Trim(Str(Val(sFourBitString))) ' 最多四位 '------------------------------------------------------------------ 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 End Function Function GetDXJE(ByVal Num As Currency) As String ' 得到大写金额 '---------------------------------------------------------------------- Dim vNum, vDec, ret, qb '------------------------------------------------------------------ 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) End If If Len(ret) = 0 Then ret = Num2RMB(Right(vNum, 4), "元", False) Else ret = ret + Num2RMB(Right(vNum, 4), "元", True) 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 GetDXJE = ret '---------------------------------------------------------------------- End Function |
|