小写人民币转大写人民币
'为了避免雷同,此程序使用数学方法(共4个函数),我经过复杂的考虑,希望酌情采纳,谢谢!
'复杂处:零的显示(消除以及合并)
'在 Form1 中添加 Text1 和 Text2 ,复制所有代码即可。 注释很详细的!
'我差点精神崩溃: "" Then UCaseNum = strGroup + "?|" Else UCaseNum = strGroup
Case 11
If strGroup <> "" Then UCaseNum = strGroup + "萬" Else UCaseNum = strGroup
Case 12
UCaseNum = strGroup '千位以内
En...全部
'为了避免雷同,此程序使用数学方法(共4个函数),我经过复杂的考虑,希望酌情采纳,谢谢!
'复杂处:零的显示(消除以及合并)
'在 Form1 中添加 Text1 和 Text2 ,复制所有代码即可。
注释很详细的!
'我差点精神崩溃: "" Then UCaseNum = strGroup + "?|" Else UCaseNum = strGroup
Case 11
If strGroup <> "" Then UCaseNum = strGroup + "萬" Else UCaseNum = strGroup
Case 12
UCaseNum = strGroup '千位以内
End Select
End Function
'在每一位数后添加相应的中文连接字符
Public Function AddString(ByVal Index As Integer, ByVal number As String, Optional ByVal Mode As Integer = 0) As String
'整数小数模式选择,默认为0
If Mode = 0 Then '小数点左边的数字
If Val(number) = 0 Then AddString = "0": Exit Function '如果为0则省略关键字,并退出函数
Select Case Index
Case 1
AddString = number + "仟"
Case 2
AddString = number + "佰"
Case 3
AddString = number + "拾"
Case 4
AddString = number '千位以内
End Select
Else '小数点右边的数字
If Val(number) = 0 Then AddString = "0": Exit Function '如果为0则省略关键字,并退出函数
If Index = 1 Then
AddString = number + "角"
ElseIf Index = 2 Then
AddString = number + "分"
Else
AddString = "" '小数点2位后的数字省略,商店中就是以小结算
End If
End If
End Function
Public Function RMB(ByVal num As String) As String
'变量声名及初始化
Dim ZArea(1 To 3) As String, FArea As String, Tmp() As String
Dim ZStr As String, FStr As String
Dim tmpRMB As String
tmpRMB = ""
num = Format(num, "000000000000。
0000") '格式化字符串
'分割为整数和小数两部分
Tmp = Split(num, "。")
ZStr = Tmp(0): FStr = Tmp(1)
'获取每组数字
'整数区
For i = 1 To 3 '获取每4位数字组的读法并用中文连接字符连接
ZArea(i) = ValNumGroup(Mid(ZStr, i * 4 - 3, 4))
tmpRMB = tmpRMB + UCaseNum(i + 9, ZArea(i))
Next i
If tmpRMB <> "" Then tmpRMB = tmpRMB + "圆" '判断整数区有无显示
'小数区
FArea = ValNumGroup(FStr, 1) '获取4位数字组的读法
tmpRMB = tmpRMB + FArea '与整数区连接
For i = 0 To 9 '替换为中文繁体数字
tmpRMB = Replace(tmpRMB, i, UCaseNum(i))
Next i
'字符串尾处理
If tmpRMB <> "" Then tmpRMB = tmpRMB + "整" '判断有无显示
RMB = tmpRMB '赋值
End Function
'初始化控件
Private Sub Form_Load()
Text1。
Text = "": Text2。Text = ""
Text2。Locked = True '锁定结果显示
End Sub
'灵敏响应输入
Private Sub Text1_Change()
If Val(Text1。
Text) >= 1000000000000# Then '输入范围
MsgBox "超过转换范围(千亿)", vbCritical + vbOKOnly, "人民币转换"
Text1。Text = "" '清除输入
ElseIf Text1。
Text <> "" Then '输入不为空
Text2。Text = RMB(CStr(Val(Text1。Text))) '函数计算并显示结果
Else '输入为空
Text2。Text = ""
End If
End Sub
'对输入的限制
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 8, 48 To 57 '退格键和数字键
Case 46 '小数点键
If InStr(Text1。
Text, "。
") <> 0 Then KeyAscii = 0: Beep '禁止输入第二个小数点并发出禁止的蜂鸣声
Case Else
KeyAscii = 0: Beep '发出禁止的蜂鸣声
End Select
End Sub。收起
