?谁有现成的将数字换为人民币大写代码？谢谢！

来源：互联网发布：手机wlan软件下载编辑：程序博客网时间：2024/05/17 06:06

感谢: tztz520

Public Function DaXie(txtJE As Double) As String
On Error GoTo err1
Dim I As Long '循环变量
Dim K As Long '记录整数位循环位置
Dim NC As String '输入金额 '
Dim chrNum As String '保存从字串中取出的数字
Dim c1 As String '中文大写单位
Dim c2 As String '中文角分
Dim c3 As String '中文大写数字
Dim Zheng As String '整数部分
Dim Xiao As String '小数部分

NC = Trim(Format(txtJE, "##0.00"))
c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
c2 = "角分"
c3 = "玖捌柒陆伍肆叁贰壹"
If NC = 0 Then
DaXie = "零元整"
Exit Function
End If

DaXie = ""
Zheng = Mid(NC, 1, (Len(NC) - 3))
Xiao = Mid(NC, (Len(Zheng) + 2), 2)
If Val(Xiao) <> 0 Then
For I = Len(Xiao) To 1 Step -1
chrNum = Mid(Xiao, I, 1)
If chrNum <> 0 Then
DaXie = Mid(c2, I, 1) & DaXie
DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie
Else
If I = 1 Then
DaXie = "零" & DaXie
End If
End If
Next I
End If

K = 0
If Val(Zheng) <> 0 Then
DaXie = "元" & DaXie
For I = Len(Zheng) To 1 Step -1
If (Len(Zheng) - I) = 4 Then
If Val(Mid(Zheng, Len(Zheng) - 4, 1)) = 0 And _
Mid(DaXie, 1, 1) <> "零" And _
Mid(DaXie, 1, 1) <> "元" Then
DaXie = "零" & DaXie
End If

If Len(Zheng) >= 9 Then
If Val(Mid(Zheng, Len(Zheng) - 7, 4)) = 0 Then
DaXie = DaXie
Else
DaXie = "万" & DaXie
End If
Else
DaXie = "万" & DaXie
End If
ElseIf (Len(Zheng) - I) = 8 Then
If Val(Mid(Zheng, Len(Zheng) - 8, 1)) = 0 And _
Mid(DaXie, 1, 1) <> "零" And _
Mid(DaXie, 1, 1) <> "元" Then
DaXie = "零" & DaXie
End If

DaXie = "亿" & DaXie
ElseIf (Len(Zheng) - I) = 12 Then
If Val(Mid(Zheng, Len(Zheng) - 12, 1)) = 0 And _
Mid(DaXie, 1, 1) <> "零" And _
Mid(DaXie, 1, 1) <> "元" Then
DaXie = "零" & DaXie
End If

DaXie = "万" & DaXie
End If
chrNum = Mid(Zheng, I, 1)
If chrNum <> 0 Then
If I = Len(Zheng) Then
DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie
Else
If (Len(Zheng) - I) <> 4 And _
(Len(Zheng) - I) <> 8 And _
(Len(Zheng) - I) <> 12 Then
DaXie = Mid(c1, (Len(c1) - K), 1) & DaXie
End If
DaXie = Mid(c3, (Len(c3) - chrNum + 1), 1) & DaXie
End If
Else
If Mid(DaXie, 1, 1) <> "元" And _
Mid(DaXie, 1, 1) <> "万" And _
Mid(DaXie, 1, 1) <> "亿" Then
If Mid(DaXie, 1, 1) <> "零" Then
DaXie = "零" & DaXie
End If
End If
End If
K = K + 1
Next I
End If
If Right(Trim(DaXie), 1) <> "分" Then
DaXie = DaXie & "整"
End If

Exit Function
err1:
MsgBox "你输入的数字太长或者格式错误.", , "提示:"
End Function

Private Sub Command1_Click()
Text2.Text = DaXie(Val(Text1.Text))
End Sub