我参考了一下excel里的程序写法,修改了一下后作了一个函数,可以在程序的任何地方调用,我是采用了excel板块的一个前辈修改的,在这里表示感谢,并且把他原来最高值为99999999的限制增加到了999999999999,可以上千亿了。
程序如下,拿出来分项,我提出的其他问题还请各位前辈帮忙为盼:
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 的汉字大写
' 最大为 999999999999
' 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 '9999 以内
Dim s3 As String '9999-99999999
Dim s4 As String '99999999以上
If N1 = "" Then
ChMoney = ""
Exit Function
End If
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" And st1 = "" Then
s1 = s1 + CCh(Val(t1)) + "角整"
Else
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
s1 = "整"
End If
'以下确定0-9999的数值
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
'以下确定9999-99999999的数值
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
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If
'以下为99999999-999999999999部分
s4 = ""
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
s4 = CCh(Val(t1)) + s4
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s4 = CCh(Val(t1)) + "拾" + s4
Else
If Left(s4, 1) <> "零" Then s4 = "零" + s4
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s4 = CCh(Val(t1)) + "佰" + s4
Else
If Left(s4, 1) <> "零" Then s4 = "零" + s4
End If
End If
If st1 <> "" Then
t1 = Right(st1, 1)
st1 = Left(st1, Len(st1) - 1)
If t1 <> "0" Then
s4 = CCh(Val(t1)) + "仟" + s4
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
If Len(s4) > 0 Then
If Right(s4, 1) = "零" Then s4 = Left(s4, Len(s4) - 1)
s4 = s4 & "亿"
End If
ChMoney = IIf(s4 & s3 & s2 = "", s1, s4 & s3 & s2 & "元" & s1)
End Function
[此贴子已经被作者于2004-10-17 13:34:33编辑过] |