本帖资料来自网络查询结果,只用于学习共享。
==================== 复制内容到剪贴板 代码rivate Function 大写金额(N As String) As String
Dim S1 As String, S2 As String, S3 As String, S As String
Dim I1 As Integer, I2 As Integer, I3 As Integer, Flag As String
If Not IsNumeric(N) Then
大写金额 = ""
Exit Function
End If
N = Format(N, "0.00")
If Left(N, 1) = "-" Then
Flag = "负"
N = Right(N, Len(N) - 1)
Else
Flag = ""
End If
'********** 转换整数部分 **********
S = Left(N, Len(N) - 3) '整数部分
大写金额 = ""
For I1 = 0 To Int(Len(S) / 8)
S3 = ""
For I2 = 0 To IIf((Len(S) - I1 * 8) > 8, 1, Int((Len(S) - I1 * 8) / 4))
S2 = ""
For I3 = 1 To IIf((Len(S) - I1 * 8 - I2 * 4) > 4, 4, Len(S) - I1 * 8 - I2 * 4)
S1 = Choose(CInt(Mid(S, Len(S) - I1 * 8 - I2 * 4 - I3 + 1, 1)) + 1, _
"零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
If S1 <> "零" Then S1 = S1 & Choose(I3, "", "拾", "佰", "仟")
If Left(S2, 1) <> S1 Then S2 = S1 & S2
Next I3
If Right(S2, 1) = "零" Then S2 = Left(S2, Len(S2) - 1)
If S2 <> "" Then S3 = S2 & Choose(I2 + 1, "", "万") & S3
Next I2
If I1 > 0 Then S3 = S3 & "亿"
大写金额 = S3 & 大写金额
Next I1
If 大写金额 <> "" Then 大写金额 = 大写金额 & "元"
'********** 转换小数部分 **********
S = Right(N, 2) '小数部分
S1 = Choose(CInt(Mid(S, 1, 1)) + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
If S1 <> "零" Then
S3 = S1 & "角"
Else
S3 = IIf(大写金额 <> "", "零", "")
End If
S2 = Choose(CInt(Mid(S, 2, 1)) + 1, "零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
If S2 <> "零" Then S3 = S3 & S2 & "分"
If S3 = "零" Then S3 = ""
大写金额 = 大写金额 & S3
If Right(大写金额, 1) = "元" Or Right(大写金额, 1) = "角" Then 大写金额 = 大写金额 & "整"
大写金额 = Flag & 大写金额
End Function |