设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1549|回复: 2
打印 上一主题 下一主题

错误在哪?

[复制链接]
跳转到指定楼层
1#
发表于 2004-7-2 04:04:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
此函数是将“12.32”字样的数据转换成“壹拾贰元叁角贰分”,运行后总是出现未定义的标签,错在哪?请大家指正!



Sub ConvertToChineseNum()

     Selection.Fields.Add Range:=Selection.Range, Text:="= " & daxie(Selection.Text)

End Sub

Function daxie(money As String) As String '

Dim x As String, y As String

Const zimu = ".sbqwsbqysbqwsbq" '定义位置代码

Const letter = "0123456789sbqwy.zjf" '定义汉字缩写

Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟萬億圆整角分" '定义大写汉字

Dim temp As String

temp = money

If InStr(temp, ".") > 0 Then temp = Left(temp, InStr(temp, ".") - 1)

If Len(temp) > 16 Then MsgBox "数目太大,无法换算!请输入一亿亿以下的数字", 64, "错误提示": Exit Function '只能转换一亿亿元以下数目的货币!

x = Format(money, "0.00") '格式化货币

y = ""

For i = 1 To Len(x) - 3

y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)

Next

If Right(x, 3) = ".00" Then

y = y & "z"          '***元整

Else

y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f"     '*元*角*分

End If

y = Replace(y, "0q", "0") '避免零千(如:40200肆萬零千零贰佰)

y = Replace(y, "0b", "0") '避免零百(如:41000肆萬壹千零佰)

y = Replace(y, "0s", "0") '避免零十(如:204贰佰零拾零肆)

Do While y <> Replace(y, "00", "0")

y = Replace(y, "00", "0") '避免双零(如:1004壹仟零零肆)

Loop

y = Replace(y, "0y", "y") '避免零億(如:210億     贰佰壹十零億)

y = Replace(y, "0w", "w") '避免零萬(如:210萬     贰佰壹十零萬)

y = IIf(Len(x) = 5 And Left(y, 1) = "1", Right(y, Len(y) - 1), y) '避免壹十(如:14壹拾肆;10壹拾)

y = IIf(Len(x) = 4, Replace(y, "0.", ""), Replace(y, "0.", ".")) '避免零元(如:20.00贰拾零圆;0.12零圆壹角贰分)

For i = 1 To 19

y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字

Next

daxie = y

End Function

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2004-7-2 07:38:00 | 只看该作者
请不要在此发关于access的帖子
3#
 楼主| 发表于 2004-7-2 17:55:00 | 只看该作者
晕!!!!这个是我在word 2000里的一个宏…………
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-9-28 06:36 , Processed in 0.113528 second(s), 27 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表