'//* 功能: 金额小写转换为大写 调用参数:jesj...人民币小写金额
'//* 返回变量: name..人民币大写金额
Public Function Fun_Jezh(Jesj As Double) As String
Dim Name1$, Name2$, Mje1$, Name$
Dim len_mje1%, k%, Ws%, j%, ws1%, m%
Dim Bz As Boolean
Name1 = "壹贰叁肆伍陆柒捌玖"
Name2 = "分角元拾佰仟万拾佰仟亿拾佰仟"
Mje1 = Trim(Format(Jesj, "###.00"))
len_mje1 = Len(Mje1)
If len_mje1 > 16 Or Jesj < 0.01 Or IsNull(Jesj) Then
Fun_Jezh = ""
Exit Function
End If
'//取无小数的字符串
Mje1 = Left(Mje1, len_mje1 - 3) + Right(Mje1, 2)
len_mje1 = len_mje1 - 1
k = len_mje1 * 2 - 1
Ws = Int(Mid(Mje1, 1, 1)) * 2 - 1
If len_mje1 = 3 And Ws < 0 Then '//如果金额<1 name=''
Name = ""
Else
If Ws > 0 Then
Name = MidB(Name1, Ws, 2) + MidB(Name2, k, 2) '//如果金额>=1,转换金额
End If
End If
j = 2
k = k - 2
Bz = True
xh1:
Do While j <= len_mje1 And Bz
ws1 = Int(Mid(Mje1, j, 1)) * 2 - 1
If ws1 > 0 Then
Name = Name + MidB(Name1, ws1, 2) + MidB(Name2, k, 2)
j = j + 1
k = k - 2
GoTo xh1
End If
m = 0
xh2:
Do While ws1 < 0
If len_mje1 >= 11 Then
If k < 21 Then
m = m + 1
End If
End If
If k = 5 Or (k = 13 And m <= 3) Or k = 21 Then
Name = Name + MidB(Name2, k, 2)
End If
If k = 1 Then
Name = Name + "整"
Bz = False
Exit Do
End If
j = j + 1
k = k - 2
ws1 = Int(Mid(Mje1, j, 1)) * 2 - 1
If ws1 < 0 Then
GoTo xh2
Else
If len_mje1 = 3 Then
Name = Name + "零"
Else
Name = Name + "零"
End If
End If
Loop
Loop
'去掉元和角之间零(1230.32)
wz1 = InStr(1, Name, "元")
wz2 = InStr(1, Name, "角")
If wz1 <> 0 And wz2 <> 0 Then
wz3 = InStr(wz1, Name, "零")
If wz3 <> 0 Then
Name = Mid(Name, 1, wz3 - 1) + Mid(Name, wz3 + 1, Len(Name))
End If
End If
Fun_Jezh = Name
End Function