[mso] Re: Convert amount into words

Masood--

This time I'll include the code. <groan> Here's code for a VB/VBA =
function
that will convert currency/integer amounts into words. It was developed =
for
a check-writing utility, so it appends the cents (numbers to the right =
of
the decimal) as a fraction at the end of the words, but you can pretty
easily strip that out. Anyway, as always, there are probably other =
(read:
better) ways of accomplishing what you've asked for, but this one works =
just
fine for me.

'------------------------------------------------------------------------=
-
Function CurrencyToWords(ByVal curN As Currency) As String
On Error GoTo Err_CTW
    Const Thousand =3D 1000@
    Const Million =3D Thousand * Thousand
    Const Billion =3D Thousand * Million
    Const Trillion =3D Thousand * Billion
   =20
    If (curN =3D 0@) Then CurrencyToWords =3D "Zero": Exit Function
   =20
    Dim strWords As String
        If (curN < 0@) Then
            strWords =3D "negative "
        Else
            strWords =3D ""
        End If
    Dim Frac As Currency: Frac =3D Abs(curN - Fix(curN))
    If (curN < 0@ Or Frac <> 0@) Then curN =3D Abs(Fix(curN))
    Dim AtLeastOne As Integer
        AtLeastOne =3D curN >=3D 1

    If (curN >=3D Trillion) Then
        strWords =3D strWords & CurrencyToWordsDigitGroup(Int(curN /
Trillion)) & " Trillion"
        curN =3D curN - Int(curN / Trillion) * Trillion
        If (curN >=3D 1@) Then strWords =3D strWords & " "
    End If

    If (curN >=3D Billion) Then
        strWords =3D strWords & CurrencyToWordsDigitGroup(Int(curN / =
Billion))
& " Billion"
        curN =3D curN - Int(curN / Billion) * Billion
        If (curN >=3D 1@) Then strWords =3D strWords & " "
    End If
   =20
    If (curN >=3D Million) Then
        strWords =3D strWords & CurrencyToWordsDigitGroup(curN \ =
Million) & "
Million"
        curN =3D curN Mod Million
        If (curN >=3D 1@) Then strWords =3D strWords & " "
    End If
   =20
    If (curN >=3D Thousand) Then
        strWords =3D strWords & CurrencyToWordsDigitGroup(curN \ =
Thousand) & "
Thousand"
        curN =3D curN Mod Thousand
        If (curN >=3D 1@) Then strWords =3D strWords & " "
    End If
   =20
    If (curN >=3D 1@) Then
        strWords =3D strWords & CurrencyToWordsDigitGroup(curN)
    End If
   =20
    If (Frac =3D 0@) Then
        strWords =3D strWords & " and No/100"
    ElseIf (Int(Frac * 100@) =3D Frac * 100@) Then
        If AtLeastOne Then strWords =3D strWords & " and "
        strWords =3D strWords & FORMAT$(Frac * 100@, "00") & "/100"
    Else
        If AtLeastOne Then strWords =3D strWords & " and "
        strWords =3D strWords & FORMAT$(Frac * 10000@, "0000") & =
"/10000"
    End If
   =20
    CurrencyToWords =3D strWords
    Debug.Print strWords
   =20
Exit_CTW:
    Exit Function
   =20
Err_CTW:
    Resume Exit_CTW
       =20
End Function
   =20
Private Function CurrencyToWordsDigitGroup(ByVal intN As Integer) As =
String
    Const Hundred =3D " Hundred"
    Const One =3D "One"
    Const Two =3D "Two"
    Const Three =3D "Three"
    Const Four =3D "Four"
    Const Five =3D "Five"
    Const Six =3D "Six"
    Const Seven =3D "Seven"
    Const Eight =3D "Eight"
    Const Nine =3D "Nine"
    Dim strWords As String
        strWords =3D ""
    Dim Flag As Integer
        Flag =3D False
   =20
    Select Case (intN \ 100)
        Case 0
            strWords =3D "":  Flag =3D False
        Case 1
            strWords =3D One & Hundred: Flag =3D True
        Case 2
            strWords =3D Two & Hundred: Flag =3D True
        Case 3
            strWords =3D Three & Hundred: Flag =3D True
        Case 4
            strWords =3D Four & Hundred: Flag =3D True
        Case 5
            strWords =3D Five & Hundred: Flag =3D True
        Case 6
            strWords =3D Six & Hundred: Flag =3D True
        Case 7
            strWords =3D Seven & Hundred: Flag =3D True
        Case 8
            strWords =3D Eight & Hundred: Flag =3D True
        Case 9
            strWords =3D Nine & Hundred: Flag =3D True
        Case Else
    End Select
   =20
    If (Flag <> False) Then intN =3D intN Mod 100
    If (intN > 0) Then
        If (Flag <> False) Then strWords =3D strWords & " "
    Else
        CurrencyToWordsDigitGroup =3D strWords
        Exit Function
    End If
   =20
    Select Case (intN \ 10)
        Case 0, 1
            Flag =3D False
        Case 2
            strWords =3D strWords & "Twenty": Flag =3D True
        Case 3
            strWords =3D strWords & "Thirty": Flag =3D True
        Case 4
            strWords =3D strWords & "Forty": Flag =3D True
        Case 5
            strWords =3D strWords & "Fifty": Flag =3D True
        Case 6
            strWords =3D strWords & "Sixty": Flag =3D True
        Case 7
            strWords =3D strWords & "Seventy": Flag =3D True
        Case 8
            strWords =3D strWords & "Eighty": Flag =3D True
        Case 9
            strWords =3D strWords & "Ninety": Flag =3D True
        Case Else
    End Select
   =20
    If (Flag <> False) Then intN =3D intN Mod 10
    If (intN > 0) Then
        If (Flag <> False) Then strWords =3D strWords & "-"
    Else
        CurrencyToWordsDigitGroup =3D strWords
        Exit Function
    End If
   =20
    Select Case (intN)
        Case 0
        Case 1
            strWords =3D strWords & One
        Case 2
            strWords =3D strWords & Two
        Case 3
            strWords =3D strWords & Three
        Case 4
            strWords =3D strWords & Four
        Case 5
            strWords =3D strWords & Five
        Case 6
            strWords =3D strWords & Six
        Case 7
            strWords =3D strWords & Seven
        Case 8
            strWords =3D strWords & Eight
        Case 9
            strWords =3D strWords & Nine
        Case 10
            strWords =3D strWords & "Ten"
        Case 11
            strWords =3D strWords & "Eleven"
        Case 12
            strWords =3D strWords & "Twelve"
        Case 13
            strWords =3D strWords & "Thirteen"
        Case 14
            strWords =3D strWords & "Fourteen"
        Case 15
            strWords =3D strWords & "Fifteen"
        Case 16
            strWords =3D strWords & "Sixteen"
        Case 17
            strWords =3D strWords & "Seventeen"
        Case 18
            strWords =3D strWords & "Eighteen"
        Case 19
            strWords =3D strWords & "Nineteen"
        Case Else
    End Select
   =20
    CurrencyToWordsDigitGroup =3D strWords
   =20
End Function
'------------------------------------------------------------------------=
-

--Jim

-----Original Message-----
From: mso-bounce@xxxxxxxxxxxxx [mailto:mso-bounce@xxxxxxxxxxxxx] On =3D =
Behalf
Of Masood Sharif
Sent: Monday, July 26, 2004 7:02 AM
To: mso@xxxxxxxxxxxxx
Subject: [mso] Re: Convert amount into words


Can anyone help me to create this custom function for converting amount =
=3D in
words:

Masood

--- Ray Blake <ray@xxxxxxxxx> wrote:
> No, you'd need to create a custom function for this
> in VBA.
>=3D20
> Ray
>=3D20
> ------------------------------------
> GR Business Process Solutions
> Ray Blake
> Head of Software Design
> ray@xxxxxxxxx
> Braedon
> Newell Road
> Hemel Hempstead
> Herts HP3 9PD
> tel: 01442 396518
> fax: 01442 389353
> www.grbps.com
> ------------------------------------
>=3D20
>=3D20
> -----Original Message-----
> From: mso-bounce@xxxxxxxxxxxxx [mailto:mso-bounce@xxxxxxxxxxxxx] On =20
>Behalf Of Masood Sharif
> Sent: 22 July 2004 15:07
> To: mso@xxxxxxxxxxxxx
> Subject: [mso] Convert amount into words
>=3D20
>=3D20
> hi everybody,
>=3D20
> Can any tell me that in EXCEL how to change a figure
> or number into words
>=3D20
> e.g 105300 into One Lac Five Thousand Three Hundred
> Only
>=3D20
> Waiting for reply
> masood
>=3D20
>
*************************************************************
> You are receiving this mail because you subscribed
> to mso@xxxxxxxxxxxxx or
> MicrosoftOffice@xxxxxxxxxxxxxxxx
>=3D20
> To send mail to the group, simply address it to mso@xxxxxxxxxxxxx =
=3D20
> To Unsubscribe from this group, send an email to
> mso-request@xxxxxxxxxxxxx with the word
> "unsubscribe" (without the quotes) in the subject
> line.
>=3D20
> Or, visit the group's homepage and use the dropdown
> menu.  This will also allow you to change your email
> settings to digest or vacation (no mail).=3D20
> http://www.freelists.org/webpage/mso
>=3D20
> To be able to use the files section for sharing
> files with the group, send a request to =
mso-moderators@xxxxxxxxxxxxx=3D20
> and you will be sent an invitation with instructions.  Once you are =
a=3D20
> member of the files group, you can go here to
> upload/download files:
> http://www.smartgroups.com/vault/msofiles
>
*************************************************************
>=3D20



        =3D09
__________________________________
Do you Yahoo!?
Yahoo! Mail - 50x more storage than other providers!
http://promotions.yahoo.com/new_mail
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx =
=3D or
MicrosoftOffice@xxxxxxxxxxxxxxxx

To send mail to the group, simply address it to mso@xxxxxxxxxxxxx

To Unsubscribe from this group, send an email to=3D20
mso-request@xxxxxxxxxxxxx with the word "unsubscribe" (without the =3D
quotes)
in the subject line.

Or, visit the group's homepage and use the dropdown menu.  This will =3D =
also
allow you to change your email settings to digest or vacation (no mail).
http://www.freelists.org/webpage/mso

To be able to use the files section for sharing files with the group, =
=3D send
a request to mso-moderators@xxxxxxxxxxxxx and you will be sent an =3D
invitation with instructions.  Once you are a member of the files group, =
you
can go here to upload/download files:
http://www.smartgroups.com/vault/msofiles
*************************************************************
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx =
or
MicrosoftOffice@xxxxxxxxxxxxxxxx

To send mail to the group, simply address it to mso@xxxxxxxxxxxxx

To Unsubscribe from this group, send an email to=20
mso-request@xxxxxxxxxxxxx with the word "unsubscribe" (without the =
quotes)
in the subject line.

Or, visit the group's homepage and use the dropdown menu.  This will =
also
allow you to change your email settings to digest or vacation (no mail).
http://www.freelists.org/webpage/mso

To be able to use the files section for sharing files with the group, =
send a
request to mso-moderators@xxxxxxxxxxxxx and you will be sent an =
invitation
with instructions.  Once you are a member of the files group, you can go
here to upload/download files: http://www.smartgroups.com/vault/msofiles
*************************************************************
*************************************************************
You are receiving this mail because you subscribed to mso@xxxxxxxxxxxxx or 
MicrosoftOffice@xxxxxxxxxxxxxxxx

To send mail to the group, simply address it to mso@xxxxxxxxxxxxx

To Unsubscribe from this group, send an email to 
mso-request@xxxxxxxxxxxxx with the word "unsubscribe" (without the quotes) in 
the subject line.

Or, visit the group's homepage and use the dropdown menu.  This will also allow 
you to change your email settings to digest or vacation (no mail).
http://www.freelists.org/webpage/mso

To be able to use the files section for sharing files with the group, send a 
request to mso-moderators@xxxxxxxxxxxxx and you will be sent an invitation with 
instructions.  Once you are a member of the files group, you can go here to 
upload/download files:
http://www.smartgroups.com/vault/msofiles
*************************************************************

Other related posts: