求VB编程：货币兑换，输入人民币，兑换成美元，比例1：8.25

控件如下蔽薯稿:

1.人民币后面的文本框 Text1

2.兑换后 后面的文本框 Text2

3.退出按钮 Command1

4.兑换按钮 Command2

5.清除按钮 Command3

6.美宏孝元单选框 Option1

7.港元单选框 Option2

代码如下

Private Sub Command1_Click()

End

End Sub

Private Sub Command2_Click()

Dim HuiLv As Currency

If Option1.Value = True Then

HuiLv = 1 / 8.25 '美元汇率

Else

HuiLv = 1 / 1.15 '港元手哗

End If

Text2 = CCur(Text1) * HuiLv

End Sub

Private Sub Command3_Click()

Text1 = ""

Text2 = ""

Text1.SetFocus

End Sub

分类: 电脑/网络 >>程序设计 >>其他编程语言

解析:

我见过这样的程序，等找到了再回答你

一时找不到那本书了，所以自己写了一个，已经测试，可用。

命名可能不是太规范，你可以再做一些修整。

源程序如下：

Option Explicit

Public Function NumberToCharacter(number As String) As String

'完成转换的主函数

Dim Pos_Point As Long '记录小数点的位置

Dim curNum As String '记录当前处理的数字

Dim zhengshu As String '记录整数部分

Dim shuduan As String '截取某一个数据此并卖段

'检索小数点的位置

Pos_Point = InStr(number, ".")

'处理小数部分

If Pos_Point = 0 Then

'没有小数点，将小数点设置在最末尾

Pos_Point = Len(number)

ElseIf Len(number) = Pos_Point Then

'以小数点结尾，不作处理

ElseIf Len(number) = Pos_Point + 1 Then

'一位小数，直接翻译为角

curNum = Right(number, 1)

NumberToCharacter = NumToChr(curNum) &"角"

ElseIf Len(number) = Pos_Point + 2 Then

'取第一位

curNum = Right(number, 1)

'若第一位为零，则不作处理，否则译为“森逗角”

If curNum <>"0" Then

NumberToCharacter = NumToChr(curNum) &"分"

End If

'取第二位

curNum = Left(Right(number, 2), 1)

'若第二为零，不作处理，否则译为“分”

If curNum <蔽仔>"0" Then

NumberToCharacter = NumToChr(curNum) &"角" &NumberToCharacter

End If

End If

'处理整数

zhengshu = ""

If Pos_Point >14 Then

'大于 9999999999999 的数据不转换

MsgBox "该数据无法转换", vbOKOnly + vbInformation, "金额转换"

Exit Function

ElseIf Pos_Point >9 Then

zhengshu = "亿"

'亿位以上的部分

shuduan = Left(number, Pos_Point - 9)

zhengshu = shuduantoCharacter(shuduan) &zhengshu

'万位以上的部分

shuduan = Right(Left(number, Pos_Point - 5), 4)

zhengshu = zhengshu &shuduantoCharacter(shuduan) &"万"

'万位以下部分

shuduan = Right(Left(number, Pos_Point - 1), 4)

zhengshu = zhengshu &shuduantoCharacter(shuduan) &"圆"

ElseIf Pos_Point >5 Then

'万位以上的部分

shuduan = Right(Left(number, Pos_Point - 5), 4)

zhengshu = zhengshu &shuduantoCharacter(shuduan) &"万"

'万位以下部分

shuduan = Right(Left(number, Pos_Point - 1), 4)

zhengshu = zhengshu &shuduantoCharacter(shuduan) &"圆"

Else

'万位以下

shuduan = Right(Left(number, Pos_Point - 1), 4)

zhengshu = zhengshu &shuduantoCharacter(shuduan) &"圆"

End If

NumberToCharacter = zhengshu &NumberToCharacter

'输入为“0”，特殊处理

If NumberToCharacter = "圆" Then

NumberToCharacter = "零圆"

End If

End Function

Public Function NumToChr(num As String) As String

'数字转化为对应的中文

Select Case num

Case "1"

NumToChr = "壹"

Case "2"

NumToChr = "贰"

Case "3"

NumToChr = "参"

Case "4"

NumToChr = "肆"

Case "5"

NumToChr = "伍"

Case "6"

NumToChr = "陆"

Case "7"

NumToChr = "柒"

Case "8"

NumToChr = "捌"

Case "9"

NumToChr = "玖"

Case "0"

NumToChr = "零"

End Select

End Function

'对分节后的每一节数据进行翻译，

'例如: 1234512341234被分为12345，1234，1234

Public Function shuduantoCharacter(duan As String) As String

Dim curNum As String

Dim answer As String

answer = ""

If Len(duan) = 5 Then

'有万位

answer = NumToChr(Left(duan, 1)) &"万"

'千位

curNum = Right(Left(duan, 2), 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum) &"仟"

Else

answer = answer &"零"

End If

'百位

curNum = Right(Left(duan, 3), 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum) &"佰"

Else

If Right(answer, 1) <>"零" Then

answer = answer &"零"

End If

End If

'十位

curNum = Right(Left(duan, 4), 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum) &"拾"

Else

If Right(answer, 1) <>"零" Then

answer = answer &"零"

End If

End If

'个位

curNum = Right(duan, 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum)

Else

If Right(answer, 1) = "零" Then

answer = Left(answer, Len(answer) - 1)

End If

End If

ElseIf Len(duan) = 4 Then

'有千位

answer = NumToChr(Left(duan, 1)) &"仟"

'百位

curNum = Left(Right(duan, 3), 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum) &"佰"

Else

If Right(answer, 1) <>"零" Then

answer = answer &"零"

End If

End If

'十位

curNum = Left(Right(duan, 2), 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum) &"拾"

Else

If Right(answer, 1) <>"零" Then

answer = answer &"零"

End If

End If

'个位

curNum = Right(duan, 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum)

Else

If Right(answer, 1) = "零" Then

answer = Left(answer, Len(answer) - 1)

End If

End If

ElseIf Len(duan) = 3 Then

'有百位

answer = NumToChr(Left(duan, 1)) &"佰"

'十位

curNum = Left(Right(duan, 2), 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum) &"拾"

Else

If Right(answer, 1) <>"零" Then

answer = answer &"零"

End If

End If

'个位

curNum = Right(duan, 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum)

Else

If Right(answer, 1) = "零" Then

answer = Left(answer, Len(answer) - 1)

End If

End If

ElseIf Len(duan) = 2 Then

'有十位

answer = NumToChr(Left(duan, 1)) &"拾"

'个位

curNum = Right(duan, 1)

If curNum <>"0" Then

answer = answer &NumToChr(curNum)

Else

If Right(answer, 1) = "零" Then

answer = Left(answer, Len(answer) - 1)

End If

End If

ElseIf Len(duan) = 1 Then

'有个位

answer = NumToChr(Left(duan, 1))

End If

shuduantoCharacter = answer

End Function

---