Convert numbers(figure) to Words.

[Oliver76]

Good day!

How can i convert numbers into words? for example, if im going to input $1555.25 in the first textbox, the word "One thousand five hundred fifty five and 25 cents will appear in the second textbox.

Pls help me solve this problem... thanx a lot in advance.

 

[rvBasic]

cfr:

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=520&lngWId=1

or

http://www.devcity.net/forums/topic.asp?tid=6785

or

http://www.fabalou.com/Access/Modules/numbertowords.htm

_________________________________
In theory, there is no difference between theory and practice. In practice, there is. [attributed to Yogi Berra]

 

[CCLINT]

Here is something I whipped up a while back, but haven't worked on the optimization, haven't checked completely the correctness, and haven't added comments and clean up yet.

But, it seems to work, and I think it uses less code than alot other examples.
You can modify to your preference and improve it.
The code also will work using other decimal and thousand seperators. You only need to change the constant used for the thousand's seperator, or get the current settings out of the country settings via API function.

[/b][/i][/u]*******************************************************
_{General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!}

 

[CCLINT]

----------------------------------------------------------
Public Function NumberToText(ByVal dNumber As Double, Optional ByVal bUseAND As Boolean, _
Optional ByVal bIsCurrency As Boolean = False, Optional ByVal bUseFraction As Boolean = False) As String
Dim sngWholeNumber As Single, sngCurrNum As Single
Dim sSign As String, sWorkStr As String, sPartResultStr As String
Dim iWorkNr As Integer, I As Integer, iMax As Integer
Dim iDecimalPlaces As Integer
Dim aryWork() As String
Const cAND$ = " and"
Const cDOT$ = " Dot "
Const cCURRENCY_BILLS$ = " Dollars"
Const cCURRENCY_COINS$ = " Cents"
Const cSPACE$ = " "
Const cTHOUSANDSEP$ = "," 'You will need to retrieve the actual seperator used

sngWholeNumber = dNumber
If sngWholeNumber < 0 Then
sSign = &quot;Minus &quot;
ElseIf sngWholeNumber = 0 Then
sPartResultStr = &quot;Zero&quot;
GoTo ExitProceedure
End If
sngWholeNumber = Int(sngWholeNumber)
aryWork = Split(Format$(Abs(sngWholeNumber), &quot;#,#&quot, cTHOUSANDSEP)
iMax = UBound(aryWork)
For I = iMax To 0 Step -1
sWorkStr = vbNullString
sngCurrNum = aryWork(I)
'Hundreds
iWorkNr = Fix(sngCurrNum / 100)
If iWorkNr > 0 Then
sWorkStr = TwoDigitsAsText(Fix(sngCurrNum / 100)) & &quot; Hundred&quot;
If (sngCurrNum / iWorkNr > 100) And bUseAND Then sWorkStr = sWorkStr & cAND
End If
'Ones and Tens
sWorkStr = sWorkStr & TwoDigitsAsText(Right$(Fix(sngCurrNum), 2))
iDecimalPlaces = iMax - I + 1
sPartResultStr = sWorkStr & _
Choose(iDecimalPlaces, vbNullString, &quot; Thousand &quot;, &quot; Million &quot;, &quot; Billion &quot;, &quot; Trillion &quot _
& sPartResultStr
Next I
If bIsCurrency Then sWorkStr = sWorkStr & &quot; Dollars &quot;
'Decimal
sngCurrNum = dNumber - Fix(dNumber)
If sngCurrNum <> 0 Then
sngCurrNum = Round(sngCurrNum, 12)
iDecimalPlaces = (Len(Str$(sngCurrNum)) - 2)
sngCurrNum = sngCurrNum * 10 ^ iDecimalPlaces
If bUseFraction Then
If sngWholeNumber Then sWorkStr = cAND$ & cSPACE
If bIsCurrency Then
sWorkStr = sWorkStr & sngCurrNum / (10 ^ (iDecimalPlaces - 2)) & &quot;/100&quot; & cCURRENCY_BILLS & cSPACE
Else
sWorkStr = sWorkStr & sngCurrNum & &quot;/&quot; & CStr(10 ^ iDecimalPlaces)
End If
Else
If bIsCurrency And sngWholeNumber Then
sWorkStr = cCURRENCY_BILLS & cAND$ & cSPACE
Else
sWorkStr = cDOT
End If
sWorkStr = sWorkStr & sngCurrNum / (10 ^ (iDecimalPlaces - 2))
If bIsCurrency Then sWorkStr = sWorkStr & cCURRENCY_COINS
End If
iDecimalPlaces = 0
End If
sPartResultStr = sPartResultStr & sWorkStr
ExitProceedure:
NumberToText = sSign & Trim$(sPartResultStr)
End Function
----------------------------------------------------------
Public Function TwoDigitsAsText(ByVal vNumber As Variant) As String
Dim sWorkStr As String
Dim iOnes As Integer, iTens As Integer

vNumber = CInt(Right$(CStr(Abs(vNumber)), 2))
If vNumber > 9 And vNumber < 20 Then
iOnes = (vNumber Mod 10) + 1
sWorkStr = Choose(iOnes, &quot;Ten&quot;, &quot; Eleven&quot;, &quot; Twelve&quot;, &quot; Thirteen&quot;, &quot; Fourteen&quot;, &quot; Fifteen&quot;, &quot; Sixteen&quot;, &quot; Seventeen&quot;, &quot; Eighteen&quot;, &quot; Nineteen&quot
Else
If vNumber > 19 Then
iOnes = (vNumber Mod 10)
iTens = Fix(vNumber / 10)
sWorkStr = Choose(iTens, &quot;&quot;, &quot; Twenty&quot;, &quot; Thirty&quot;, &quot; Fourty&quot;, &quot; Fifty&quot;, &quot; Sixty&quot;, &quot; Seventy&quot;, &quot; Eighty&quot;, &quot; Ninety&quot
Else
iOnes = vNumber
End If

If iTens <> 0 And iOnes <> 0 Then sWorkStr = sWorkStr & &quot; &quot;
sWorkStr = sWorkStr & Choose(iOnes, &quot;One&quot;, &quot;Two&quot;, &quot;Three&quot;, &quot;Four&quot;, &quot;Five&quot;, &quot;Six&quot;, &quot;Seven&quot;, &quot;Eight&quot;, &quot;Nine&quot
End If
TwoDigitsAsText = sWorkStr
End Function [/b][/i][/u]*******************************************************
_{General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!}

 

[MichaelRed]

see faq181-1740

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[CCLINT]

Ok, a couple of small errors:
1. Add
sWorkStr = vbNullString
right after the line:
'Decimal

2. Change at the end of the first function these 2 lines:

sWorkStr = sWorkStr & sngCurrNum / (10 ^ (iDecimalPlaces - 2))
If bIsCurrency Then sWorkStr = sWorkStr & cCURRENCY_COINS
to read:

If bIsCurrency Then
sWorkStr = sWorkStr & sngCurrNum / (10 ^ (iDecimalPlaces - 2))
sWorkStr = sWorkStr & cCURRENCY_COINS
Else
sWorkStr = sWorkStr & sngCurrNum
End If

MichaelRed:
I've seen your FAQ posted before (and noticed that it was written in ACCESS) and was interested in it, but saw that not all the functions seem to work for me.
I could only get the basNum2Word function works when the control panel settings are set to U.S.

With-out me having searching through all of the code, do you remember where changes need to be made for this to work internationally?
One thing I noticed is that I would probably need to change the Val() function to the Str$() function.
Thank you. [/b][/i][/u]*******************************************************
_{General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!}

 

[cdukes]

I have written a recursive version of the above that anyone can use if required. The code is written as a class module with one public function 'ToWords'. Please fell free to comment.

Chris Dukes


Option Explicit

Const NUM_MILLION = 1000000
Const NUM_THOUSAND = 1000
Const NUM_HUNDRED = 100


Private Function Hundreds(lngConvert As Long) As String
Dim i As Integer
Dim strHundred As String
On Error GoTo Hundreds_Err



i = lngConvert \ NUM_HUNDRED

' Convert the hundreds to a string
strHundred = ToString(i)

' If there where any hundreds,
' add the wording
If Len(strHundred) <> 0 Then
If lngConvert Mod NUM_HUNDRED = 0 Then
strHundred = strHundred & &quot; HUNDRED&quot;
Else
strHundred = strHundred & &quot; HUNDRED AND &quot;
End If
End If

' Now convert the remainer
strHundred = strHundred & ToString(lngConvert Mod NUM_HUNDRED)


Hundreds = strHundred


Hundreds_Exit:
Exit Function

Hundreds_Err:
Resume Hundreds_Exit
End Function



Public Function ToWords(lngConvert As Long) As String

On Error GoTo ToWords_Err


ToWords = Millions(lngConvert)


ToWords_Exit:
Exit Function

ToWords_Err:
Resume ToWords_Exit
End Function

Function ToString(i As Integer) As String
Dim itens As Integer
On Error GoTo ToString_Err



itens = i \ 10

Select Case itens
Case 0
Select Case i
Case 0
ToString = &quot;&quot;
Case 1
ToString = &quot;ONE&quot;
Case 2
ToString = &quot;TWO&quot;
Case 3
ToString = &quot;THREE&quot;
Case 4
ToString = &quot;FOUR&quot;
Case 5
ToString = &quot;FIVE&quot;
Case 6
ToString = &quot;SIX&quot;
Case 7
ToString = &quot;SEVEN&quot;
Case 8
ToString = &quot;EIGHT&quot;
Case 9
ToString = &quot;NINE&quot;
End Select

Case 1
Select Case i
Case 10
ToString = &quot;TEN&quot;
Case 11
ToString = &quot;ELEVEN&quot;
Case 12
ToString = &quot;TWELVE&quot;
Case 13
ToString = &quot;THIRTEEN&quot;
Case 14
ToString = &quot;FOURTEEN&quot;
Case 15
ToString = &quot;FIFTEEN&quot;
Case 16
ToString = &quot;SIXTEEN&quot;
Case 17
ToString = &quot;SEVENTEEN&quot;
Case 18
ToString = &quot;EIGHTEEN&quot;
Case 19
ToString = &quot;NINETEEN&quot;
End Select
Case 2
ToString = &quot;TWENTY &quot; & ToString(i Mod 10)
Case 3
ToString = &quot;THIRTY &quot; & ToString(i Mod 10)
Case 4
ToString = &quot;FOURTY &quot; & ToString(i Mod 10)
Case 5
ToString = &quot;FIFTY &quot; & ToString(i Mod 10)
Case 6
ToString = &quot;SIXTY &quot; & ToString(i Mod 10)
Case 7
ToString = &quot;SEVENTY &quot; & ToString(i Mod 10)
Case 8
ToString = &quot;EIGHTY &quot; & ToString(i Mod 10)
Case 9
ToString = &quot;NINETY &quot; & ToString(i Mod 10)
End Select



ToString_Exit:
Exit Function

ToString_Err:
Resume ToString_Exit
End Function
Private Function Thousands(lngConvert As Long) As String
Dim i As Long
Dim strThousand As String
On Error GoTo Thousands_Err



i = lngConvert \ NUM_THOUSAND

' Convert the hundreds to a string
strThousand = Hundreds(i)

' If there where any hundreds,
' add the wording
If Len(strThousand) <> 0 Then
If lngConvert Mod NUM_THOUSAND >= NUM_HUNDRED Or lngConvert Mod NUM_THOUSAND = 0 Then
strThousand = strThousand & &quot; THOUSAND &quot;
Else
strThousand = strThousand & &quot; THOUSAND AND &quot;
End If
End If

' Now convert the remainer
strThousand = strThousand & Hundreds(lngConvert Mod NUM_THOUSAND)

Thousands = strThousand


Thousands_Exit:
Exit Function

Thousands_Err:
Resume Thousands_Exit
End Function

Private Function Millions(lngConvert As Long) As String
Dim i As Long
Dim strMillion As String
On Error GoTo Millions_Err



i = lngConvert \ NUM_MILLION

' Convert the hundreds to a string
strMillion = Thousands(i)

' If there where any hundreds,
' add the wording
If Len(strMillion) <> 0 Then
If lngConvert Mod NUM_MILLION > 1000 Or lngConvert Mod NUM_MILLION = 0 Then
strMillion = strMillion & &quot; MILLION &quot;
Else
strMillion = strMillion & &quot; MILLION AND &quot;
End If
End If
' Now convert the remainer
strMillion = strMillion & Thousands(lngConvert Mod NUM_MILLION)

Millions = strMillion


Millions_Exit:
Exit Function

Millions_Err:
Resume Millions_Exit
End Function

 

[cdukes]

Please note, the above does not cater for decimals, but it would not be difficult to alter

chris Dukes

 

[MichaelRed]

CCLINT,

I have not 'worked' with the international settings, so any 'advice' I give on the topic is -at best- taken with caution, As far as I understand it, the international settings would only affect the decimial seperator and currency symbols. If it were me, I would probably just add a small routine near the beginning to check the input value and replace any foregin symbols with the equivalent U.S. Symbols. A mirror routine near the end would be necessary to translate the string to whatever language. since I'n not even very good with my native language, I cannot imagine doing the translation to a variety of foregin languages, so would 'leave it to Beaver'. You also mention needing to use Str vs. Val - but do not elaborte on where or why, so I cannor even begin to respond to this. Sorry that I am so parochical, but just have not enough international experience to feel comfortable in that arena.

If you have specific comments on the faq -as written- there is a mechanisim for you to communicate these to me directly.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[MichaelRed]

hmmmmmmmm,

CCLINT,

Only because of the implied request to critique it:

You note that it is possible to use international settings to get the thousands seperator, but cast it as a const.

You refer to interntionalization - yet use U.S. terminology throughout w/o reference in other locales / countries some of these are 'hard coded' strings distribuited throught the procedures. (See several 'choose' statements as well as a few other 'odd words), while others are (again) cast as constants.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[CCLINT]

MichaelRed:
Yes, as with my function, it was only a matter of adding a constant for the decimal seperator, or querying the system for the decimal seperator, and doing a search and replace on &quot;,&quot;, . Then your example (basNum2Word) works.

basDecNum2Words also did not work because of this:

Nz(T1)

After just replacing Nz(T1) every where with T1, it seems to work also.

I also like your idea of converting to words the decimal places also into Tenths, Hundredths, Thousandths, etc., instead of just single digit words.
-----------------------------------------------------------

With my function above, I was thinking mostly currency, so if just a number conversion is desired, where the number has decimal places, the returned value is in words for the whole number part, but digits for the decimal portion.

So a correction would be:

Change at the end of function NumberToText:

If bIsCurrency Then
sWorkStr = sWorkStr & sngCurrNum / (10 ^ (iDecimalPlaces - 2))
sWorkStr = sWorkStr & cCURRENCY_COINS
Else
sWorkStr = sWorkStr & sngCurrNum
End If


to:

If bIsCurrency Then
sWorkStr = sWorkStr & sngCurrNum / (10 ^ (iDecimalPlaces - 2))
sWorkStr = sWorkStr & cCURRENCY_COINS
Else

For I = 1 To Len(Trim$(sngCurrNum))
iWorkNr = Mid$(sngCurrNum, I, 1)
sWorkStr = sWorkStr & Choose(iWorkNr, &quot;One&quot;, &quot;Two&quot;, &quot;Three&quot;, &quot;Four&quot;, &quot;Five&quot;, &quot;Six&quot;, &quot;Seven&quot;, &quot;Eight&quot;, &quot;Nine&quot & cSPACE
Next I
End If [/b][/i][/u]*******************************************************
_{General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!}

 

[JohnYingling]

I have used the following to &quot;detect&quot; decimal separator.
If CCur(&quot;1.000&quot = 1 Then
mstrDecimalSeparator = &quot;.&quot;
Else
mstrDecimalSeparator = &quot;,&quot;
End If

http://www.VBResizer.com

Forms/Controls Resizing/Tabbing Control

http://www.VBCompare.com

Compare Code (Text)

http://www.VBSortGen.com

Generate Sort Class in VB or VBScript

 

[CCLINT]

MichaelRed:
Thanks for the critic.

Yes, I guess I did not make myself clear:
If one uses the code on different locals, then it is best to query the system for the decimal seperator, otherwise, just supplying the constant is sufficient.

Even though one may have the country set to US, the decimal seperator may be something else (I often will leave the system set to the country that I am in, but change to a different local for dates and numbers).

Internationalization:
In the Choose function, just like in your functions, one would have to change the text to reflect a certain language, and, if this is to be used for several languages, one would have to set up a data source for the different languages and dump the the words into variables, using the variables to return the correct text.
While this may be possible in a few languages, it is impossible for others.
I do not see any real problem doing this between western european countries and U.S. languages though.

The constants for currency type (dollar, Euro, etc) would also have to be changed to reflect the local. Or is it better to also allow the user pass the Bills and Coins text (thinking of my own pocket which often has several currencies types in it)?

I need to consider what ways are best in dealing with this, if possible, and your code may be the better tool in implementing such a function for multi-locales usage.

>..few other odd words...&quot;
Yesssss, I know...that's the problem with my english after being 22 years out of the U.S. (1/2 my life!) and living/visiting foreign countries all the time, primary language not English anymore except in these forums.....

JohnYingling: Now why didn't I think of that?!
Actually, I think I saw this somewhere long, long ago.....
100% reliable it isn't, but all countries which I have dealt with use one or the other (comma or dot as a thousands seperator), and if a error (13) occurs, then probaly because the user has been playing with the country settings and forgot to set it back. [/b][/i][/u]*******************************************************
_{General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!}