asked on

convert a numeric amount into words

can somebody help me ?

I writing a program in VB6

I need to convert a numeric shekel(Israeli currency)
amount into text for use in such applications as
printing a check.

From:
yulyos@yahoo.com

hongjun

Try this piece of code. Use CStr() to convert any datatype to String.

Private Sub Form_Load()
Dim strMoney As String
Dim intMoney As Currency

intMoney = 32.5
MsgBox intMoney
strMoney = CStr(intMoney)
MsgBox strMoney
End Sub

hongjun

inthedark

Used to do this in the old days when printing cheques, pre electronic transfer days, but now its only used in voice synthesis.

Let me know how you get on.

MsgBox SpeakNumeric(1234.56)

Function SpeakNumeric(Value, Optional DoPence As Boolean = True) As String

' example:

'A$=SpeakNumeric(123456.78)
' note the dopence parameter is only used internally

Dim CurrencyName$
Dim DecimalName$
Dim CurrencyDecimals As Long
CurrencyDecimals = 2

CurrencyName = "Shekles"
DecimalName$ = "Agorot"

ReDim n$(20)
ReDim t$(10)
ReDim th$(3)

n$(0) = "Zero"
n$(1) = "One"
n$(2) = "Two"
n$(3) = "Three"
n$(4) = "Four"
n$(5) = "Five"
n$(6) = "Six"
n$(7) = "Seven"
n$(8) = "Eight"
n$(9) = "Nine"
n$(10) = "Ten"
n$(11) = "Eleven"
n$(12) = "Twelve"
n$(13) = "Thirteen"
n$(14) = "Fourteen"
n$(15) = "Fifteen"
n$(16) = "Sixteen"
n$(17) = "Seventeen"
n$(18) = "Eighteen"
n$(19) = "Nineteen"

t$(2) = "Twenty"
t$(3) = "Thirty"
t$(4) = "Forty"
t$(5) = "Fifty"
t$(6) = "Sixty"
t$(7) = "Seventy"
t$(8) = "Eighty"
t$(9) = "Ninety"

th$(0) = "Hundred"
th$(1) = "Thousand"
th$(2) = "Million"
th$(3) = "Billion"

Dim Numeric As Currency
Dim S$

'new shekel agorot

Numeric = Value

Dim pence As Currency
Dim intpart As Currency

Dim ln As Long
Dim item$
Dim pot$

pence = Abs(Numeric) - (Abs(Int(Numeric)))
pence = Int(pence * (10 ^ CurrencyDecimals))

intpart = Int(Abs(Numeric))

S$ = CStr(intpart)

ln = Len(S$)

' do we have any billions
If ln > 9 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 9)), False)
GoSub AddToPot
item = th$(3): GoSub AddToPot

S$ = Mid$(S$, Len(S$) - 8)

End If

GoSub RemoveLeadingZeros
ln = Len(S$)

' do we have any millions
If ln > 6 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 6)), False)
GoSub AddToPot
item = th$(2): GoSub AddToPot
S$ = Mid$(S$, Len(S$) - 5)
End If

GoSub RemoveLeadingZeros
ln = Len(S$)

' do we have any thousands
If ln > 3 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 3)), False)
GoSub AddToPot
item = th$(1): GoSub AddToPot
S$ = Mid$(S$, Len(S$) - 2)
End If

' do we have any hundreds
If ln > 2 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 2)), False)
GoSub AddToPot
item = th$(0): GoSub AddToPot

item = "And": GoSub AddToPot ' this is optional

S$ = Mid$(S$, 2)
End If

Dim vl As Long

' now do the rest
vl = Val(S$)
If vl > 19 Then
item = t$(Int(vl * 0.1)): GoSub AddToPot
vl = vl - (Int(vl * 0.1) * 10)
If vl > 0 Then
item = n$(vl)
GoSub AddToPot
End If
Else
item = n(vl)
GoSub AddToPot
End If

If DoPence Then
item = CurrencyName: GoSub AddToPot
item = "And " + SpeakNumeric(pence, False) + " " + DecimalName
GoSub AddToPot
End If

SpeakNumeric = LCase(pot)

Exit Function

RemoveLeadingZeros:

Dim lz As Long

For lz = 1 To Len(S$) - 1
If Mid$(S$, lz, 1) <> "0" Then
S$ = Mid$(S$, lz)
Exit For
End If
Next lz

Return

AddToPot:

If Len(pot) Then
pot = pot + " "
End If
pot = pot + item

Return

End Function

inthedark

I improved the code:

Function SpeakNumeric(Value, Optional DoPence As Boolean = True) As String

' example:

' A$=SpeakNumeric(123456.78)
' note the dopence parameter is only used internally

Dim CurrencyName$
Dim DecimalName$
Dim CurrencyDecimals As Long
CurrencyDecimals = 2

CurrencyName = "Shekles"
DecimalName$ = "Agorot"

ReDim n$(20)
ReDim t$(10)
ReDim th$(3)

n$(0) = "zero"
n$(1) = "one"
n$(2) = "owo"
n$(3) = "three"
n$(4) = "four"
n$(5) = "five"
n$(6) = "six"
n$(7) = "seven"
n$(8) = "eight"
n$(9) = "nine"
n$(10) = "ten"
n$(11) = "eleven"
n$(12) = "twelve"
n$(13) = "thirteen"
n$(14) = "fourteen"
n$(15) = "fifteen"
n$(16) = "sixteen"
n$(17) = "seventeen"
n$(18) = "eighteen"
n$(19) = "nineteen"

t$(2) = "twenty"
t$(3) = "thirty"
t$(4) = "forty"
t$(5) = "fifty"
t$(6) = "sixty"
t$(7) = "seventy"
t$(8) = "eighty"
t$(9) = "ninety"

th$(0) = "hundred"
th$(1) = "thousand"
th$(2) = "million"
th$(3) = "billion"

Dim Numeric As Currency
Dim S$

'new shekel agorot

Numeric = Value

Dim pence As Currency
Dim intpart As Currency

Dim ln As Long
Dim item$
Dim pot$

pence = Abs(Numeric) - (Abs(Int(Numeric)))
pence = Int(pence * (10 ^ CurrencyDecimals))

intpart = Int(Abs(Numeric))

S$ = CStr(intpart)

ln = Len(S$)

' do we have any billions
If ln > 9 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 9)), False)
GoSub AddToPot
item = th$(3): GoSub AddToPot
S$ = Mid$(S$, Len(S$) - 8)
GoSub RemoveLeadingZeros
End If

' do we have any millions
If ln > 6 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 6)), False)
GoSub AddToPot
item = th$(2): GoSub AddToPot
S$ = Mid$(S$, Len(S$) - 5)
GoSub RemoveLeadingZeros
End If

' do we have any thousands
If ln > 3 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 3)), False)
GoSub AddToPot
item = th$(1): GoSub AddToPot
S$ = Mid$(S$, Len(S$) - 2)
GoSub RemoveLeadingZeros
End If

' do we have any hundreds
If ln > 2 Then
item$ = SpeakNumeric(Val(Left$(S$, Len(S$) - 2)), False)
GoSub AddToPot
item = th$(0): GoSub AddToPot
S$ = Mid$(S$, 2)
GoSub RemoveLeadingZeros
End If

Dim vl As Long

' now do the rest
vl = Val(S$)
If vl > 19 Then
If Len(pot) > 0 Then
item = "And": GoSub AddToPot ' this is optional
End If
item = t$(Int(vl * 0.1)): GoSub AddToPot
vl = vl - (Int(vl * 0.1) * 10)
If vl > 0 Then
item = n$(vl)
GoSub AddToPot
End If
Else
If vl = 0 And Len(pot) > 0 Then
' dont need to add the zero
Else
If Len(pot) > 0 Then
item = "And": GoSub AddToPot ' this is optional
End If
item = n(vl)
GoSub AddToPot
End If
End If

If DoPence Then
item = CurrencyName: GoSub AddToPot
item = "And " + SpeakNumeric(pence, False) + " " + DecimalName
GoSub AddToPot
End If

SpeakNumeric = LCase(pot)

Exit Function

RemoveLeadingZeros:

Dim lz As Long

Do
For lz = 1 To Len(S$) - 1
If Mid$(S$, lz, 1) <> "0" Then
S$ = Mid$(S$, lz)
Exit Do
End If
Next lz
S$ = "0"
Exit Do
Loop
ln = Len(S$)

Return

AddToPot:

If Len(pot) Then
pot = pot + " "
End If
pot = pot + item

Return

End Function

inthedark

At the end of the function change:

SpeakNumeric = LCase(pot)

to

SpeakNumeric = pot

In this way the currency name should stay in upper case.

yulyos

ASKER

To inthedark:

your code is excellent,
but not for Hebrew language

ASKER CERTIFIED SOLUTION

inthedark

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial