计算大写金额

Function setCapitalizedAmount(key As String) As String
Dim Session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Set db = Session.CurrentDatabase
Set doc = Session.DocumentContext
'将数字转换在人民币在写
Dim strMoney ,strDec, strInt, cNum ,tmp1 As String
Dim subString As String
Dim locDec, i, j As Integer
Dim d(4) As String '元以下的单位
Dim t(3) As String '万以下的单位
Dim w(3) As String '阶符
Dim n(9) As String '数字
Dim s(4) As String '用以保存临时转化后的值

Dim temp As Variant

d(0) = ""
d(1) = "角"
d(2) = "分"
d(3) = "厘"
d(4) = "毫"
t(0) = ""
t(1) = "拾"
t(2) = "佰"
t(3) = "仟"
w(0) = ""
w(1) = "圆"
w(2) = "万"
w(3) = "亿"
n(0) = "零"
n(1) = "壹"
n(2) = "贰"
n(3) = "叁"
n(4) = "肆"

n(5) = "伍"
n(6) = "陆"
n(7) = "柒"
n(8) = "捌"
n(9) = "玖"

If Trim(key)<>"" Then

strMoney = Trim(key)

locDec = Instr(strMoney, ".")
s(0) = ""

If locDec > 0 Then
strDec = Right(strMoney, Len(strMoney) - locDec)

If strDec <> "" Then '转化小数部分
For i = 1 To Len(strDec)
cNum = Left(strDec, 1)
strDec = Right(strDec, Len(strDec) - 1)
If cNum <> "0" Then
s(0) = s(0) & n(Val(cNum)) & d(i)

End If
Next
End If
strInt = Left(strMoney, locDec - 1) '取整数部分的值
Else
strInt = strMoney
End If

For i = 0 To Len(strInt) / 4 '每4个数字一组进行转换

s(i + 1) = ""
For j = 0 To 3
If strInt <> "" Then
cNum = Right(strInt, 1) '取末位数
strInt = Left(strInt, Len(strInt) - 1)
If cNum <> "0" Then '不为零则加单位
s(i + 1) = n(Val(cNum)) & t(j) & s(i + 1)
Else

s(i + 1) = n(Val(cNum)) & s(i + 1)
End If
End If

' doc.temp1=s(i+1)
'删除重复的"零"
' doc.temp1=Evaluate(|@ReplaceSubstring(temp1;"零零";"零")|,doc)
' s(i+1)=doc.temp1(0)

'temp = s(i+1)
temp = Evaluate(|@ReplaceSubstring("|+s(i+1)+|";"零零";"零")|)
s(i+1) = temp(0)

Next
If Right(s(i + 1), 1) = "零" Then '删除末位的"零"
s(i + 1) = Left(s(i + 1), Len(s(i + 1)) - 1)
End If


Next

Num2Money = ""
For i = 0 To 2
If Trim(s(3 - i)) = "" Then
temp=""
Else
temp=w(3 - i)
End If
'连接整数位
Num2Money = Num2Money & s(3 - i) & temp
Next

'加上"元"
If Trim(Num2Money) <> "" And Right(Num2Money, 1) <> "圆" Then
Num2Money = Num2Money & "圆"

End If
'若无小数则加应加上"整"
If Trim(s(0)) = "" Then
Num2Money = Num2Money & "整"
'doc.Bmoney=Num2Money
setCapitalizedAmount = Num2Money
Else
Num2Money = Num2Money & s(0)
'doc.Bmoney=Num2Money
setCapitalizedAmount = Num2Money
End If
Else
setCapitalizedAmount = ""
End If
Exit Function
End Function

posted @ 2019-04-24 15:32  比岸  阅读(153)  评论(0编辑  收藏  举报