BIGmiralli Frequent Poster
Joined: 17 Apr 2007 Posts: 38 Location: Boston, Massachusetts
|
Posted: Fri May 23, 2008 1:00 pm Post subject: Convert Number to spoken word value |
|
|
The below link contains a database with one module in it. The module contains various functions, but of note is the function NumberToWords
If you call the following in code NumberToWords(1234543) it will return "One Million Two Hundred and Thirty Four Thousand Five Hundred and Fourty Three"
This function will convert any positive number upto 999,999,999,999, to do negatives just check before calling this function if the number is negative make it a positive and stick minus in front of it.
Code: | Public Function NumberToWords(OrigNum As Long) As String
'This function converts numbers to words. For example 101 -> One hundred and one
'It uses standard english notation and will only accept positive long numbers
Dim billionpart As Long
Dim millionpart As Long
billionpart = Int(OrigNum / 1000000000)
millionpart = OrigNum Mod 1000000000
NumberToWords = HundredsToWords(billionpart) & IIf(billionpart <> 0, " billion", "")
If millionpart > 99 Then
NumberToWords = NumberToWords & IIf(millionpart <> 0 And billionpart <> 0, " ", "") & millionstowords(millionpart)
Else
NumberToWords = NumberToWords & IIf(millionpart <> 0 And billionpart <> 0, " and ", "") & millionstowords(millionpart)
End If
End Function
Public Function millionstowords(millionnumber As Long)
Dim millionpart As Long
Dim thousandpart As Long
millionpart = Int(millionnumber / 1000000)
thousandpart = millionnumber Mod 1000000
millionstowords = HundredsToWords(millionpart) & IIf(millionpart <> 0, " million", "")
If thousandpart > 99 Then
millionstowords = millionstowords & IIf(thousandpart <> 0 And millionpart <> 0, " ", "") & thousandstowords(thousandpart)
Else
millionstowords = millionstowords & IIf(thousandpart <> 0 And millionpart <> 0, " and ", "") & thousandstowords(thousandpart)
End If
End Function
Public Function thousandstowords(thousandnumber As Long) As String
Dim thousandpart As Long
Dim HundredPart As Long
HundredPart = thousandnumber Mod 1000
thousandpart = Int(thousandnumber / 1000)
thousandstowords = HundredsToWords(thousandpart) & IIf(thousandpart <> 0, " thousand", "")
If HundredPart > 99 Then
thousandstowords = thousandstowords & IIf(HundredPart <> 0 And thousandpart <> 0, " ", "") & HundredsToWords(HundredPart)
Else
thousandstowords = thousandstowords & IIf(HundredPart <> 0 And thousandpart <> 0, " and ", "") & HundredsToWords(HundredPart)
End If
End Function
Public Function HundredsToWords(HundredNumber As Long) As String
'This function converts a three digit long to the hundred wording
Dim TensPart As Long
Dim HundredPart As Long
TensPart = HundredNumber Mod 100
HundredPart = Int(HundredNumber / 100)
Select Case HundredPart
Case 0
HundredsToWords = TensToWords(TensPart)
Case Else
HundredsToWords = SingleToWord(HundredPart) & " Hundred" & IIf(TensPart <> 0, " and ", "") & TensToWords(TensPart)
End Select
End Function
Public Function TensToWords(TensNumber As Long) As String
'This function converts a two digit long to a two digit wording
Dim tens As Long
Dim Singles As Long
tens = Int(TensNumber / 10)
Singles = TensNumber Mod 10
Select Case tens
Case 0
TensToWords = SingleToWord(Singles)
Case 1
TensToWords = teens(TensNumber)
Case 2
TensToWords = "Twenty" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 3
TensToWords = "Thirty" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 4
TensToWords = "Fourty" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 5
TensToWords = "Fifty" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 6
TensToWords = "Sixty" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 7
TensToWords = "Seventy" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 8
TensToWords = "Eighty" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
Case 9
TensToWords = "Ninety" & IIf(Singles <> 0, " ", "") & SingleToWord(Singles)
End Select
End Function
Public Function SingleToWord(SingleDigit As Long) As String
Select Case SingleDigit
Case 1
SingleToWord = "One"
Case 2
SingleToWord = "Two"
Case 3
SingleToWord = "Three"
Case 4
SingleToWord = "Four"
Case 5
SingleToWord = "Five"
Case 6
SingleToWord = "Six"
Case 7
SingleToWord = "Seven"
Case 8
SingleToWord = "Eight"
Case 9
SingleToWord = "Nine"
Case 0
SingleToWord = ""
End Select
End Function
Public Function teens(TeenNumber As Long) As String
Select Case TeenNumber
Case 10
teens = "Ten"
Case 11
teens = "Eleven"
Case 12
teens = "Twelve"
Case 13
teens = "Thirteen"
Case 14
teens = "Fourteen"
Case 15
teens = "Fifteen"
Case 16
teens = "Sixteen"
Case 17
teens = "Seventeen"
Case 18
teens = "Eighteen"
Case 19
teens = "Nineteen"
End Select
End Function |
Authors Note : If you want to deal with non-integer numbers i.e. 96.54 then replace the main NumberToWords function with the function below
Code: | Public Function NumberToWords(OrigNum As Double) As String
'This function converts numbers to words. For example 101 -> One hundred and one
'It uses standard English notation and will only accept positive long numbers
Dim billionpart As Long
Dim millionpart As Long
Dim decimalpart As Double
Dim tmpstr As String
Dim intpart As Long
tmpstr = Format$(OrigNum, "0.00")
tmpstr = Right(tmpstr, Len(tmpstr) - InStr(1, tmpstr, "."))
decimalpart = CLng(tmpstr)
intpart = CLng(OrigNum - CDbl("0." & tmpstr))
'Now int part is correct and decimal
billionpart = Int(intpart / 1000000000)
millionpart = intpart Mod 1000000000
NumberToWords = HundredsToWords(billionpart) & IIf(billionpart <> 0, " billion", "")
If millionpart > 99 Then
NumberToWords = NumberToWords & IIf(millionpart <> 0 And billionpart <> 0, " ", "") & millionstowords(millionpart)
Else
NumberToWords = NumberToWords & IIf(millionpart <> 0 And billionpart <> 0, " and ", "") & millionstowords(millionpart)
End If
'Now do decimal part bit
NumberToWords = NumberToWords & " And " & CStr(decimalpart) & "/" & "100"
End Function |
________
Fr80 |
|