View Single Post
 
Old 09-12-2011, 05:13 AM
Catalin.B Catalin.B is offline Windows Vista Office 2007
Expert
 
Join Date: May 2011
Location: Iaşi, Romānia
Posts: 386
Catalin.B is on a distinguished road
Default

All code and text from below here is the work of Microsoft.

(means you could find it yourself.. )
Code:
Option Explicit



      '****************

      ' Main Function *

      '****************



      Function SpellNumber(ByVal MyNumber)

          Dim Dollars, Cents, Temp

          Dim DecimalPlace, Count



          ReDim Place(9) As String

          Place(2) = " Thousand "

          Place(3) = " Million "

          Place(4) = " Billion "

          Place(5) = " Trillion "



          ' String representation of amount.

          MyNumber = Trim(Str(MyNumber))



          ' Position of decimal place 0 if none.

          DecimalPlace = InStr(MyNumber, ".")

          ' Convert cents and set MyNumber to dollar amount.

          If DecimalPlace > 0 Then

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

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

          End If



          Count = 1

          Do While MyNumber <> ""

              Temp = GetHundreds(Right(MyNumber, 3))

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

              If Len(MyNumber) > 3 Then

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

              Else

                  MyNumber = ""

              End If

              Count = Count + 1

          Loop



          Select Case Dollars

              Case ""

                  Dollars = "No Dollars"

              Case "One"

                  Dollars = "One Dollar"

              Case Else

                  Dollars = Dollars & " Dollars"

          End Select



          Select Case Cents

              Case ""

                  Cents = " and No Cents"

              Case "One"

                  Cents = " and One Cent"

              Case Else

                  Cents = " and " & Cents & " Cents"

          End Select



          SpellNumber = Dollars & Cents

      End Function







      '*******************************************

      ' Converts a number from 100-999 into text *

      '*******************************************



      Function GetHundreds(ByVal MyNumber)

          Dim Result As String



          If Val(MyNumber) = 0 Then Exit Function

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



          ' Convert the hundreds place.

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

              Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

          End If



          ' Convert the tens and ones place.

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

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

          Else

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

          End If



          GetHundreds = Result

      End Function







      '*********************************************

      ' Converts a number from 10 to 99 into text. *

      '*********************************************



     Function GetTens(TensText)

          Dim Result As String



          Result = ""           ' Null out the temporary function value.

          If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...

              Select Case Val(TensText)

                  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                                 ' If value between 20-99...

              Select Case Val(Left(TensText, 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

              Result = Result & GetDigit(Right(TensText, 1))   ' Retrieve ones place.

          End If

          GetTens = Result

      End Function









      '*******************************************

      ' Converts a number from 1 to 9 into text. *

      '*******************************************



      Function GetDigit(Digit)

          Select Case Val(Digit)

              Case 1: GetDigit = "One"

              Case 2: GetDigit = "Two"

              Case 3: GetDigit = "Three"

              Case 4: GetDigit = "Four"

              Case 5: GetDigit = "Five"

              Case 6: GetDigit = "Six"

              Case 7: GetDigit = "Seven"

              Case 8: GetDigit = "Eight"

              Case 9: GetDigit = "Nine"

              Case Else: GetDigit = ""

          End Select

      End Function
If you want to show "/100" at the end of the spell, replace
This " and No Cents" in line 101 with: "and 0/100"
" and One Cent" with " and 1/100" line 105

" Cents" with " /100"-line 109
Attached Files
File Type: xlsm Copie a Query103-Value to Words.xlsm (21.1 KB, 14 views)
Reply With Quote