[mso] Re: Convert amount into words
- From: "Jim Pettit" <j_e_pettit@xxxxxxxxxxx>
- To: <mso@xxxxxxxxxxxxx>
- Date: Mon, 26 Jul 2004 07:40:04 -0700
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
> //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).
//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).
//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).
//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:
