当前位置:编程学习 > VB >>

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"

               C

上一个:求VB中的Like运算符的资料
下一个:求VB代码 对应易语言的

CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,