[分享]修改后的人民币大小写转换模块
时间:2009-03-31 08:56 来源:本站原创 作者:wfm324 阅读:次
尾数为“分”时,最后不出现“整”字
大写字段=chMoney(Val([小写字段]))
Public Function CCh(N1) As String Select Case N1 Case 0 CCh = "零" Case 1 CCh = "壹" Case 2 CCh = "贰" Case 3 CCh = "叁" Case
4 CCh = "肆" Case 5 CCh = "伍" Case 6 CCh = "陆" Case 7 CCh = "柒" Case 8 CCh = "捌" Case 9 CCh = "玖" End Select End
Function
'名称: ChMoney ' 得到数字 N1 的汉字大写。最大为 千万位。 O 返回 Public Function chMoney(N1) As String Dim tMoney As String
Dim lMoney As String Dim tn '小数位置 Dim s1 As String '临时STRING 小数部分 Dim s2 As String '1000 以内 Dim s3 As String
'10000 Dim st1, t1
If N1 = 0 Then chMoney = " " Exit Function End If If N1 < 0 Then chMoney = "负" + chMoney(Abs(N1)) Exit Function End If
tMoney = Trim(Str(N1)) tn = InStr(tMoney, ".") '小数位置 s1 = ""
If tn <> 0 Then st1 = Right(tMoney, Len(tMoney) - tn) If st1 <> "" Then t1 = Left(st1, 1) st1 = Right(st1, Len(st1) - 1) If
t1 <> "0" Then s1 = s1 + CCh(Val(t1)) + "角" End If If st1 <> "" Then t1 = Left(st1, 1) s1 = s1 + CCh(Val(t1)) + "分" End If
End If st1 = Left(tMoney, tn - 1) Else st1 = tMoney End If
s2 = "" If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) s2 = CCh(Val(t1)) + s2 End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s2 = CCh(Val(t1)) + "拾" + s2 Else If
Left(s2, 1) <> "零" Then s2 = "零" + s2 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s2 = CCh(Val(t1)) + "佰" + s2 Else If
Left(s2, 1) <> "零" Then s2 = "零" + s2 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s2 = CCh(Val(t1)) + "仟" + s2 Else If
Left(s2, 1) <> "零" Then s2 = "零" + s2 End If End If
s3 = "" If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) s3 = CCh(Val(t1)) + s3 End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s3 = CCh(Val(t1)) + "拾" + s3 Else If
Left(s3, 1) <> "零" Then s3 = "零" + s3 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s3 = CCh(Val(t1)) + "佰" + s3 Else If
Left(s3, 1) <> "零" Then s3 = "零" + s3 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s3 = CCh(Val(t1)) + "仟" + s3 End If End
If If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1) If Len(s3) > 0 Then If Right(s3, 1) = "零" Then s3 = Left(s3, Len
(s3) - 1) s3 = s3 & "万" End If
chMoney = IIf(s3 & s2 = "", IIf(IIf(Len(tMoney) = 2, 3, (Len(tMoney)) - tn) <> 2, s1 & "整", s1), s3 & s2 & "元" & IIf(IIf
(Len(tMoney) = 2, 3, (Len(tMoney)) - tn) <> 2, s1 & "整", s1))
End Function
用法:新建一个模块,复制粘贴保存!小写字段的更新后事件里写入: 大写字段= chMoney(Val([小写字段])。
大写字段=chMoney(Val([小写字段]))
Public Function CCh(N1) As String Select Case N1 Case 0 CCh = "零" Case 1 CCh = "壹" Case 2 CCh = "贰" Case 3 CCh = "叁" Case
4 CCh = "肆" Case 5 CCh = "伍" Case 6 CCh = "陆" Case 7 CCh = "柒" Case 8 CCh = "捌" Case 9 CCh = "玖" End Select End
Function
'名称: ChMoney ' 得到数字 N1 的汉字大写。最大为 千万位。 O 返回 Public Function chMoney(N1) As String Dim tMoney As String
Dim lMoney As String Dim tn '小数位置 Dim s1 As String '临时STRING 小数部分 Dim s2 As String '1000 以内 Dim s3 As String
'10000 Dim st1, t1
If N1 = 0 Then chMoney = " " Exit Function End If If N1 < 0 Then chMoney = "负" + chMoney(Abs(N1)) Exit Function End If
tMoney = Trim(Str(N1)) tn = InStr(tMoney, ".") '小数位置 s1 = ""
If tn <> 0 Then st1 = Right(tMoney, Len(tMoney) - tn) If st1 <> "" Then t1 = Left(st1, 1) st1 = Right(st1, Len(st1) - 1) If
t1 <> "0" Then s1 = s1 + CCh(Val(t1)) + "角" End If If st1 <> "" Then t1 = Left(st1, 1) s1 = s1 + CCh(Val(t1)) + "分" End If
End If st1 = Left(tMoney, tn - 1) Else st1 = tMoney End If
s2 = "" If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) s2 = CCh(Val(t1)) + s2 End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s2 = CCh(Val(t1)) + "拾" + s2 Else If
Left(s2, 1) <> "零" Then s2 = "零" + s2 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s2 = CCh(Val(t1)) + "佰" + s2 Else If
Left(s2, 1) <> "零" Then s2 = "零" + s2 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s2 = CCh(Val(t1)) + "仟" + s2 Else If
Left(s2, 1) <> "零" Then s2 = "零" + s2 End If End If
s3 = "" If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) s3 = CCh(Val(t1)) + s3 End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s3 = CCh(Val(t1)) + "拾" + s3 Else If
Left(s3, 1) <> "零" Then s3 = "零" + s3 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s3 = CCh(Val(t1)) + "佰" + s3 Else If
Left(s3, 1) <> "零" Then s3 = "零" + s3 End If End If
If st1 <> "" Then t1 = Right(st1, 1) st1 = Left(st1, Len(st1) - 1) If t1 <> "0" Then s3 = CCh(Val(t1)) + "仟" + s3 End If End
If If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1) If Len(s3) > 0 Then If Right(s3, 1) = "零" Then s3 = Left(s3, Len
(s3) - 1) s3 = s3 & "万" End If
chMoney = IIf(s3 & s2 = "", IIf(IIf(Len(tMoney) = 2, 3, (Len(tMoney)) - tn) <> 2, s1 & "整", s1), s3 & s2 & "元" & IIf(IIf
(Len(tMoney) = 2, 3, (Len(tMoney)) - tn) <> 2, s1 & "整", s1))
End Function
用法:新建一个模块,复制粘贴保存!小写字段的更新后事件里写入: 大写字段= chMoney(Val([小写字段])。
(责任编辑:admin)
顶一下
(0)
0%
踩一下
(0)
0%
相关内容
- ·关于 Partition 函数在分组查询中的应
- ·Access算术运算符的含义和说明表
- ·mid函数的另类用法
- ·access制作程序运行进度框
- ·Function与Sub的异同(函数调用)
- ·Access判断某个数值是否为某个数据类型
- ·select case后面语句块的值的四种格式
- ·vba条件语句的两种表示方法
- ·Access几种数据类型初始化的值
- ·Access vba null与""空字符串的区别
- ·access vba 数据类型表
- ·Access变量的命名规则
- ·Access中EXIT Sub与End Sub的区别
- ·Access vba中参数前关键字ByRef和ByVal
- ·Access列表框快速全选的技巧【最快】
- ·vba函数的数据类型强制转换
最新内容
推荐内容