VB 将数字转换做英文大写

VB 将数字转换做英文大写

就比如我在textbox里输入110523 他就会转换成“one hundred and ten thousand and five hundred and twenty three”

如果你觉得我的这个描述跟你的有点差异(我的这个是精确到分的，所以多了dollars and no cents)，你就自己改下代码！代码如下

Function ConvertCurrencyToEnglish(ByVal MyNumber) As String

Dim Temp

    Dim Dollars, Cents

    Dim DecimalPlace, Count

    ReDim Place(9) As String

    Place(2) = " Thousand "

    Place(3) = " Million "

    Place(4) = " Billion "

    Place(5) = " Trillion "

    ' Convert MyNumber to a string, trimming extra spaces.

    MyNumber = Trim(Str(MyNumber))

    ' Find decimal place.

    DecimalPlace = InStr(MyNumber, ".")

    ' If we find decimal place...

    If DecimalPlace > 0 Then

    ' Convert cents

    Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)

    Cents = ConvertTens(Temp)

    ' Strip off cents from remainder to convert.

    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

    End If

    Count = 1

    Do While MyNumber <> ""

    ' Convert last 3 digits of MyNumber to English dollars.

    Temp = ConvertHundreds(Right(MyNumber, 3))

    If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

    If Len(MyNumber) > 3 Then

    ' Remove last 3 converted digits from MyNumber.

    MyNumber = Left(MyNumber, Len(MyNumber) - 3)

    Else

    MyNumber = ""

    End If

    Count = Count + 1

    Loop

    ' Clean up dollars.

    Select Case Dollars

    Case ""

    Dollars = "No Dollars"

    Case "One"

    Dollars = "One Dollar"

    Case Else

    Dollars = Dollars & " Dollars"

    End Select

    ' Clean up cents.

    Select Case Cents

    Case ""

    Cents = " And No Cents"

    Case "One"

    Cents = " And One Cent"

    Case Else

    Cents = " And " & Cents & " Cents"

    End Select

    ConvertCurrencyToEnglish = Dollars & Cents

End Function

Private Function ConvertHundreds(ByVal MyNumber)

Dim Result As String

    ' Exit if there is nothing to convert.

    If Val(MyNumber) = 0 Then Exit Function

    ' Append leading zeros to number.

    MyNumber = Right("000" & MyNumber, 3)

    ' Do we have a hundreds place digit to convert?

    If Left(MyNumber, 1) <> "0" Then

    Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "

    End If

    ' Do we have a tens place digit to convert?

    If Mid(MyNumber, 2, 1) <> "0" Then

    Result = Result & ConvertTens(Mid(MyNumber, 2))

    Else

    ' If not, then convert the ones place digit.

    Result = Result & ConvertDigit(Mid(MyNumber, 3))

    End If

    ConvertHundreds = Trim(Result)

End Function

Private Function ConvertTens(ByVal MyTens)

Dim Result As String

    ' Is value between 10 and 19?

    If Val(Left(MyTens, 1)) = 1 Then

    Select Case Val(MyTens)

    Case 10: Result = "Ten"

    Case 11: Result = "Eleven"

    Case 12: Result = "Twelve"

    Case 13: Result = "Thirteen"

    Case 14: Result = "Fourteen"

    Case 15: Result = "Fifteen"

    Case 16: Result = "Sixteen"

    Case 17: Result = "Seventeen"

    Case 18: Result = "Eighteen"

    Case 19: Result = "Nineteen"

    Case Else

    End Select

    Else

    ' .. otherwise it's between 20 and 99.

    Select Case Val(Left(MyTens, 1))

    Case 2: Result = "Twenty "

    Case 3: Result = "Thirty "

    Case 4: Result = "Forty "

    Case 5: Result = "Fifty "

    Case 6: Result = "Sixty "

    Case 7: Result = "Seventy "

    Case 8: Result = "Eighty "

    Case 9: Result = "Ninety "

    Case Else

    End Select

    ' Convert ones place digit.

    Result = Result & ConvertDigit(Right(MyTens, 1))

    End If

    ConvertTens = Result

End Function

Private Function ConvertDigit(ByVal MyDigit)

Select Case Val(MyDigit)

    Case 1: ConvertDigit = "One"

    Case 2: ConvertDigit = "Two"

    Case 3: ConvertDigit = "Three"

    Case 4: ConvertDigit = "Four"

    Case 5: ConvertDigit = "Five"

    Case 6: ConvertDigit = "Six"

    Case 7: ConvertDigit = "Seven"

    Case 8: ConvertDigit = "Eight"

    Case 9: ConvertDigit = "Nine"

    Case Else: ConvertDigit = ""

    End Select

End Function

Private Sub Command1_Click()
MsgBox ConvertCurrencyToEnglish(Val(Me.Text1.Text))
End Sub

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息