Office中国论坛/Access中国论坛

标题: [原创]阿拉伯数字转大写(用在财务金额的转换) [打印本页]

作者: pzhccy    时间: 2006-3-23 23:12
标题: [原创]阿拉伯数字转大写(用在财务金额的转换)
添加过程,函数如下:

Public Function Num2Str(num As Double) As String
If num >= 1000000000 Then Exit Function
    Dim temp1 As String
    Dim temp2 As String
    Dim temp3 As String
    x = 0
    temp1 = "零壹贰叁肆伍陆柒捌玖"
    temp2 = "元拾佰仟万拾佰仟亿"
    temp3 = "角分"
    ss = Round(num, 2)
    s = Split(ss, ".")
    ss = Trim$(s(0))
For i = 1 To Len(ss)
n = Val(Mid$(ss, i, 1)) + 1

Num2Str = Num2Str & Mid$(temp1, n, 1) & Mid$(temp2, Len(ss) - i + 1, 1)

If Right(Num2Str, 2) = "零亿" Then Num2Str = Left(Num2Str, Len(Num2Str) - 2) & "亿"
If Right(Num2Str, 2) = "零万" Then Num2Str = Left(Num2Str, Len(Num2Str) - 2) & "万"
If Right(Num2Str, 2) = "零仟" Then Num2Str = Left(Num2Str, Len(Num2Str) - 2)
If Right(Num2Str, 2) = "零元" Then Num2Str = Left(Num2Str, Len(Num2Str) - 2) & "元"
If Right(Num2Str, 2) = "零佰" Then Num2Str = Left(Num2Str, Len(Num2Str) - 2)
If Right(Num2Str, 2) = "零拾" Then Num2Str = Left(Num2Str, Len(Num2Str) - 2)

Next i

For i = 1 To Len(Num2Str)
If Mid(Num2Str, i, 1) = "仟" And Mid(Num2Str, i + 2, 1) = "万" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "仟" And Mid(Num2Str, i + 2, 1) = "拾" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "仟" And Mid(Num2Str, i + 2, 1) = "元" Then
If Mid(Num2Str, i + 1, 1) = "万" Then
Else
Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
End If
End If
If Mid(Num2Str, i, 1) = "佰" And Mid(Num2Str, i + 2, 1) = "元" Then
If Mid(Num2Str, i + 1, 1) = "万" Then
Else
Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
End If
End If
If Mid(Num2Str, i, 1) = "万" And Mid(Num2Str, i + 2, 1) = "佰" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "万" And Mid(Num2Str, i + 2, 1) = "拾" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "万" And Mid(Num2Str, i + 2, 1) = "元" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "佰" And Mid(Num2Str, i + 2, 1) = "万" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "亿" And Mid(Num2Str, i + 2, 1) = "拾" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "亿" And Mid(Num2Str, i + 2, 1) = "佰" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)
If Mid(Num2Str, i, 1) = "亿" And Mid(Num2Str, i + 2, 1) = "万" Then Num2Str = Left(Num2Str, i) & "零" & Mid(Num2Str, i + 1, Len(Num2Str) - i)

Next i


If UBound(s) >= 1 Then
ss = Trim$(s(1))
For i = 1 To 2
n = Val(Mid$(ss, i, 1))
If n <> 0 Then
Num2Str = Num2Str & Mid$(temp1, n + 1, 1) & Mid$(temp3, i, 1)
Else
If Right$(Num2Str, 1) <> "零" Then Num2Str = Num2Str & "零"
End If
Next i
If Right$(Num2Str, 1) = "零" Then Num2Str = Left$(Num2Str, Len(Num2Str) - 1)
Else
Num2Str = Num2Str & "整"
End If

End Function



使用如下:

Text52.Value = Num2Str(Text43.Value)
作者: yefei80    时间: 2006-11-25 21:47
翻跟斗风格
作者: pengkuo    时间: 2006-11-26 05:28
不错哦!!!!
作者: z12509258    时间: 2010-3-3 17:17
感谢之情 无法形容 谢谢啊
作者: huanghai    时间: 2010-3-3 21:04
很实用,谢谢分享!




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3