Office中国论坛/Access中国论坛

标题: 求助报表中如何设置大写 [打印本页]

作者: 雨后的天空 时间: 2009-2-23 15:59
标题: 求助报表中如何设置大写
在报表中如何使文本框的（大写）等于合计值
如：合计值为11690.00 大写应自动显示为壹万壹仟陆佰玖拾元整

作者: 雨后的天空 时间: 2009-2-23 16:11
怎么没人呢请求各位大侠帮帮忙在线等谢谢了

作者: todaynew 时间: 2009-2-23 16:11
Excel 中好像有人民币转换函数.Access估计要自定义一个函数,或许有人写过,搜索一下.

作者: todaynew 时间: 2009-2-23 16:17

在报表中如何使文本框的（大写）等于合计值
如：合计值为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

作者: 雨后的天空 时间: 2009-2-23 16:24
能帮我下忙吗？我有点看不懂我上传个附件你帮我做一个谢谢

作者: 雨后的天空 时间: 2009-2-23 16:24
再次感谢

作者: 雨后的天空 时间: 2009-2-23 16:30
最多能到10万的

作者: 雨后的天空 时间: 2009-2-23 16:40
标题: RE: 求助报表数字转换大写如何设置
代码我有了但是在哪些呀？
我的大写是在报表页脚上的合计金额最多能到十万元的
如壹拾伍万叁仟陆佰玖拾贰元整

作者: todaynew 时间: 2009-2-23 17:03

代码我有了但是在哪些呀？
我的大写是在报表页脚上的合计金额最多能到十万元的
如壹拾伍万叁仟陆佰玖拾贰元整
雨后的天空发表于 2009-2-23 16:40

我试试

作者: todaynew 时间: 2009-2-23 17:13

代码我有了但是在哪些呀？
我的大写是在报表页脚上的合计金额最多能到十万元的
如壹拾伍万叁仟陆佰玖拾贰元整
雨后的天空发表于 2009-2-23 16:40

声明:函数不是我写的,是搜索人家的代码.

[attach]35682[/attach]
[attach]35683[/attach]
[attach]35684[/attach]

作者: 雨后的天空 时间: 2009-2-23 18:06
太感谢了以解决

作者: chaojianan 时间: 2009-2-23 21:23
学习下。

作者: Henry D. Sy 时间: 2009-2-24 06:20
楼主提问前应该先搜索论坛，这类问题示例好多。

作者: minifu 时间: 2012-5-26 19:35
根据版主“todaynew”大哥提供的“db1.rar”，我解决了自己的问题，顺便帮楼主做了一个，这么好的东西大家分享！

作者: ycxchen 时间: 2012-5-27 10:37
14楼的朋友精神可喜！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)