Dim Strdxje As String
Function CmycurD(num As Double)
Strdxje = ""
Dim str1 As String
str1 = "零壹贰叁肆伍陆柒捌玖" '//0-9所对应的汉字
Dim str2 As String
str2 = "万仟佰拾亿仟佰拾万仟佰拾元角分" '; //数字位所对应的汉字
Dim str3 As String
str3 = "" '; //从原num值中取出的值
Dim str4 As String
str4 = "" '; //数字的字符串形式
Dim str5 As String
str5 = "" '; //人民币大写金额形式
Dim i As Integer '; //循环变量
Dim j As Integer '; //num的值乘以100的字符串长度
Dim ch1 As String
ch1 = "" '; //数字的汉语读法
Dim ch2 As String
ch2 = "" '; //数字位的汉字读法
Dim nzero As Integer
nzero = 0 '; //用来计算连续的零值是几个
Dim temp As Integer '; //从原num值中取出的值
num = Math.Round(Math.Abs(num), 2) '; //将num取绝对值并四舍五入取2位小数
str4 = Trim(Str(num * 100)) '; //将num乘100并转换成字符串形式
j = Len(str4) '; //找出最高位
If (j > 15) Then MsgBox "金额位数不能大于15位"
Dim str22 As String
str2 = Mid(str2, (15 - j) + 1) '; //取出对应位数的str2的值。如:200.55,j为5所以str2=佰拾元角分
'//循环取出每一位需要转换的值
'for(i=0;i<j;i++)
For i = 0 To j - 1
str3 = Mid(str4, i + 1, 1) '; //取出需转换的某一位的值
temp = Int(str3) '; //转换为数字
If (i <> (j - 3) And i <> (j - 7) And i <> (j - 11) And i <> (j - 15)) Then
' //当所取位数不为元、万、亿、万亿上的数字时
If (str3 = "0") Then
ch1 = "" ';
ch2 = "" ';
nzero = nzero + 1 ';
Else
If (str3 <> "0" And nzero <> 0) Then
ch1 = "零" + Mid(str1, (temp * 1) + 1, 1) ';
ch2 = Mid(str2, i + 1, 1) ';
nzero = 0 ';
Else
ch1 = Mid(str1, (temp * 1) + 1, 1) ';
ch2 = Mid(str2, i + 1, 1) ';
nzero = 0 ';
End If
End If
Else
'//该位是万亿,亿,万,元位等关键位
If (str3 <> "0" And nzero <> 0) Then
ch1 = "零" + Mid(str1, (temp * 1) + 1, 1) ';
ch2 = Mid(str2, i + 1, 1) ';
nzero = 0 ';
Else
If (str3 <> "0" And nzero = 0) Then
ch1 = Mid(str1, (temp * 1) + 1, 1) ';
ch2 = Mid(str2, i + 1, 1) ';
nzero = 0 ';
Else
If (str3 = "0" And nzero >= 3) Then
ch1 = "" ';
ch2 = "" ';
nzero = nzero + 1 ';
Else
If (j >= 11) Then
ch1 = "" ';
nzero = nzero + 1 ';
Else
ch1 = "" ';
ch2 = Mid(str2, i + 1, 1) ';
nzero = nzero + 1 ';
End If
End If
End If
End If
End If
If (i = (j - 11) Or i = (j - 3)) Then
' //如果该位是亿位或元位,则必须写上
ch2 = Mid(str2, i + 1, 1) ';
End If
str5 = str5 + ch1 + ch2 ';
If (i = j - 1 And str3 = "0") Then
'//最后一位(分)为0时,加上“整”
str5 = str5 + "整" ';
End If
Next i
If (num = 0) Then
str5 = "零元整" ';
End If
Strdxje = str5 'return str5;
End Function
'用法
Private Sub Command1_Click()
Dim je As Double
Dim str1 As String
str1 = Trim(Me.Text1)
je = Val(str1)
CmycurD (je)
MsgBox Strdxje
End Sub