vb程序设计 将阿拉伯数字转换成大写人民币金额 这是小弟的VB结课设计...
发布网友
发布时间：2022-05-12 19:49
共3个回答
热心网友
时间：2022-04-27 17:15
Check1.Value = 0
Check2.Value = 1
End Sub
'参数一为数字
'参数二为是不是返回人民币大写
'参数三为带有十百千等单位
'参数四为设置小数点后面的位数，默认为4
'使用方法是
't = GetChinaNum(20005.000436, , , 7) '返回 “二千零五点零零零四三六”
't = GetChinaNum(2005.436, True, , 7) '返回“贰仟零伍元肆角肆分”
't = GetChinaNum(2005.436, , True, 7) '返加“二零零五点四三六”
'原作者:thinkeasy 出处：中国IT动力 改写: 雪国浪子
Function GetChinaNum(otherNum As Double, Optional isRMB As Boolean, Optional numOption As Boolean, Optional dotNum As Integer) As String
On Error Resume Next
Num = Trim(Str(Int(otherNum)))
'-------------------------------------------------------
'判断是否需要转化为人民币大写，给出两种情况下的中文单位
If isRMB Then
numwei = "拾佰仟万拾佰仟亿拾佰仟"
numshu = "零壹贰叁肆伍陆柒捌玖拾"
Else
numwei = "十百千万十百千亿十百千"
numshu = "零一二三四五六七*十"
End If
'-------------------------------------------------------
'如果数字大于等于9并且小于20，则数字应转化为“十*”
If otherNum < 20 And otherNum >= 10 Then
Num = Right(Num, 1)
GetChinaNum = Left(numwei, 1)
End If
'-------------------------------------------------------
'转化程序开始
For i = 1 To Len(Num)
bstr = Mid(Num, i, 1)
If numOption Then
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
If bstr = "0" Then
If Mid(numwei, Len(Num) - i, 1) = "万" Or Mid(numwei, Len(Num) - i, 1) = "亿" Then
Do While Right(GetChinaNum, 1) = "零"
GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)
Loop
GetChinaNum = GetChinaNum + Mid(numwei, Len(Num) - i, 1)
End If
Else
GetChinaNum = GetChinaNum + Mid(numwei, Len(Num) - i, 1)
End If
GetChinaNum = Replace(GetChinaNum, "零零", "零")
Else
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
End If
Next i
'-------------------------------------------------------
'判断是否需要显示数字单位
If numOption = False Then
Do While Right(GetChinaNum, 1) = "零"
GetChinaNum = Left(GetChinaNum, Len(GetChinaNum) - 1)
Loop
End If
'-------------------------------------------------------
'判断是否需要显示人民币大写，如果需要，进一步转化
If isRMB Then
numrmb = "元角分"
GetChinaNum = GetChinaNum + Mid(numrmb, 1, 1)
If Val(Num) <> otherNum Then
Num = Trim(Str(Round(otherNum - Val(Num), 2)))
For i = 2 To Len(Num)
bstr = Mid(Num, i, 1)
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1) + Mid(numrmb, i, 1)
Next i
Else
GetChinaNum = GetChinaNum + "整"
End If
Else
If Val(Num) <> otherNum Then
Num = Trim(CStr(Round(otherNum - Val(Num), dotNum)))
If GetChinaNum = "" Then GetChinaNum = "零"
GetChinaNum = GetChinaNum + "点"
For i = 2 To Len(Num)
bstr = Mid(Num, i, 1)
GetChinaNum = GetChinaNum + Mid(numshu, Val(bstr) + 1, 1)
Next i
End If
End If
End Function
'转化数字的 CommandButton
Private Sub Command1_Click()
Dim Num As Double, dot As Integer
Dim Chk_RMB As Boolean, Chk_Unit As Boolean
Dim ChResult As String
If Text1.Text = "" Then
Label5.Caption = "请输入需要转化的阿拉伯数字。"
Else
Num = Val(Text1.Text)
If Text2.Text = "" Then
Text2.Text = "4"
End If
dot = Val(Text2.Text)
Chk_RMB = CBool(Check1.Value)
Chk_Unit = CBool(Check2.Value)
ChResult = GetChinaNum(Num, Chk_RMB, Chk_Unit, dot)
Label5.Caption = ChResult
End If
End Sub
'复原输入框的 CommandButton
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = "4"
Check1.Value = 0
Check2.Value = 1
Label5.Caption = ""
End Sub
'判TextBox1中输入的是否是数字或小数点
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And (Chr(KeyAscii) <> ".") And (KeyAscii <> 8) Then
KeyAscii = 0
Label5.Caption = "只允许输入数字或小数点"
End If
End Sub
热心网友
时间：2022-04-27 18:33
Unload Me
End Sub
'转换函数
Function Up(Dxs As String) As String
'检测为空时
If Trim(Dxs) = "" Then
MsgBox "没有数字，不能转换!", vbOKOnly + 32
Exit Function
End If
Dim Sw As Integer, SzP As Integer, SzUp As Integer, TempStr As String, DXStr As String
Sw = Len(Trim(Dxs))
SzP = InStr(1, Trim(Dxs), ".")
If SzP = 0 Then
Dim i As Integer
For i = 1 To Sw
TempStr = Right(Trim(Dxs), i)
TempStr = Left(TempStr, 1)
TempStr = Converts(TempStr)
Select Case i
Case 1
If TempStr = "零" Then
TempStr = "元"
Else
TempStr = TempStr + "元"
End If
Case 2
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "拾"
End If
Case 3
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "佰"
End If
Case 4
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "仟"
End If
Case 5
If TempStr = "零" Then
TempStr = "万"
Else
TempStr = TempStr + "万"
End If
Case 6
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "拾"
End If
Case 7
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "佰"
End If
Case 8
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "仟"
End If
Case 9
If TempStr = "零" Then
TempStr = "亿"
Else
TempStr = TempStr + "亿"
End If
End Select
Dim TempA As String
TempA = Left(Trim(DXStr), 1)
If TempStr = "零" Then
Select Case TempA
Case "零"
DXStr = DXStr
Case "元"
DXStr = DXStr
Case "万"
DXStr = DXStr
Case "亿"
DXStr = DXStr
Case Else
DXStr = TempStr + DXStr
End Select
Else
DXStr = TempStr + DXStr
End If
Next
Else
For i = 1 To SzP - 1
TempStr = Right(Trim(Dxs), i + (Sw - SzP + 1))
TempStr = Left(TempStr, 1)
TempStr = Converts(TempStr)
Select Case i
Case 1
If TempStr = "零" Then
TempStr = "元"
Else
TempStr = TempStr + "元"
End If
Case 2
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "拾"
End If
Case 3
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "佰"
End If
Case 4
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "仟"
End If
Case 5
If TempStr = "零" Then
TempStr = "万"
Else
TempStr = TempStr + "万"
End If
Case 6
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "拾"
End If
Case 7
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "佰"
End If
Case 8
If TempStr = "零" Then
TempStr = "零"
Else
TempStr = TempStr + "仟"
End If
Case 9
If TempStr = "零" Then
TempStr = "亿"
Else
TempStr = TempStr + "亿"
End If
Case Else
'超过999999999时自动删除
TempStr = ""
End Select
TempA = Left(Trim(DXStr), 1)
If TempStr = "零" Then
Select Case TempA
Case "零"
DXStr = DXStr
Case "元"
DXStr = DXStr
Case "万"
DXStr = DXStr
Case "亿"
DXStr = DXStr
Case Else
DXStr = TempStr + DXStr
End Select
Else
DXStr = TempStr + DXStr
End If
Next
'计算小数
Dim DxstrX As String, XStr As String
XStr = Right(Trim(Dxs), Sw - SzP)
For i = 1 To Sw - SzP
TempStr = Left(XStr, i)
TempStr = Right(TempStr, 1)
TempStr = Converts(TempStr)
Select Case i
Case 1
If TempStr = "零" Then
TempStr = ""
Else
TempStr = TempStr + "角"
End If
Case 2
If TempStr = "零" Then
TempStr = ""
Else
TempStr = TempStr + "分"
End If
Case Else
'超过两位小数时，自动删除
TempStr = ""
End Select
DxstrX = DxstrX + TempStr
Next
DXStr = DXStr + DxstrX
End If
Up = DXStr
End Function
Function Converts(NumStr As String) As String
Select Case Val(NumStr)
Case 0
Converts = "零"
Case 1
Converts = "壹"
Case 2
Converts = "贰"
Case 3
Converts = "叁"
Case 4
Converts = "肆"
Case 5
Converts = "伍"
Case 6
Converts = "陆"
Case 7
Converts = "柒"
Case 8
Converts = "捌"
Case 9
Converts = "玖"
End Select
End Function
Function NumberTrue(keyNumber As Integer, NumberStr As TextBox) As Boolean
'转入退格键时
If keyNumber = 8 Then
If Len(NumberStr.Text) > 0 Then
NumberStr.Text = Left(NumberStr.Text, Len(NumberStr.Text) - 1)
NumberStr.SelStart = Len(NumberStr.Text)
NumberStr.SelLength = 0
NumberTrue = True
Exit Function
End If
End If
If keyNumber >= 46 And keyNumber <= 57 And keyNumber <> 47 Then
NumberTrue = True
Else
NumberTrue = False
End If
End Function
Private Sub Convert_Click()
Label1.Caption = Up(Text1.Text)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If NumberTrue(KeyAscii, Text1) = False Then
KeyAscii = 0
End If
End Sub
热心网友
时间：2022-04-27 20:08
发到了空间!
看下面 ^_^
参考资料：http://hi.baidu.com/yiqnypl/blog/item/183c7b4f32787c2eafc3ab9e.html
