| |
Converting a Currency Amount to a Descriptive String
|
|
Posted on 2/18/2001
|
|
Author: Matthew Ferry
|
|
Email: Not Shown
|
|
Applies To OS: All
|
|
Product: 5, 6
|
Converting a Currency Amount to a Descriptive String
Example: Deriving the string "Twenty-Eight Thousand Five Hundred Forty-Three Dollars and 67 Cents"
from a Currency variable with a value of $28,543.57.
If you have to write an application that prints checks, then the following code is for you! It accepts a
standard currency variable and returns a descriptive english phrase that specifies the amount using words.
The code is pretty straight forward but is a little tedious - which is why you might want to use it instead
of inventing it yourself! These two routines are used in a number of production apps - but please have the common sense to
test the code yourself before sticking your neck out with someone elses bank account! We cannot be held accountable for any problems
you may experience with this or any other code or material posted on our site.
Please see our "disclaimer."
This code is called in the following manner:
Dim strEnglish as String
Dim curAmount as Currency
curAmount = 28543.67
'here is the call
strEnglish = DollarsAndCents(curAmount)
Debug.Print Format(curAmount, "Currency")
Debug.Print strEnglish
The above will print the following on the Debug window:
$28,543.67
Twenty-Eight Thousand Five Hundred Forty-Three Dollars And 67 Cents
The source for this is wrapped up as a class and is available as a download
| Add both routines to either a .BAS module or a .CLS module. |
|---|
Option Explicit
Public Function DollarsAndCents(curAmount As Currency) As String
Dim str As String
Dim strReturn As String
Dim strCents As String
Dim strDollars As String
'Dim strOnes As String
Dim strTens As String
Dim strHundreds As String
Dim strThousands As String
Dim strTenThousands As String
Dim strHundredThousands As String
str = Format$(curAmount, "Currency")
strCents = Right$(str, 2)
If strCents = "00" Then
strCents = " Even"
Else
strCents = " And " & strCents & " Cents"
End If
'replace cents with zeros so that it does not round up or down
Mid$(str, Len(str) - 1, 2) = "00"
'convert to long to get a clean value
str = CStr(CLng(str))
'determine length and parse accordingly
Select Case Len(str)
Case 1 'use 1s only
If str = "1" Then
strDollars = "One Dollar"
Else
strDollars = NumberToWord(CInt(str)) & " Dollars"
End If
Case 2 '1s and 10s
strDollars = NumberToWord(CInt(str)) & " Dollars"
Case 3
strHundreds = Mid$(str, 1, 1)
strTens = Mid$(str, 2, 2)
strDollars = NumberToWord(CInt(strHundreds)) & " Hundred " & _
NumberToWord(CInt(strTens)) & " Dollars"
Case 4
strThousands = Mid$(str, 1, 1)
strHundreds = Mid$(str, 2, 1)
strTens = Mid$(str, 3, 2)
strDollars = NumberToWord(CInt(strThousands)) & " Thousand " & _
NumberToWord(CInt(strHundreds)) & " Hundred " & _
NumberToWord(CInt(strTens)) & " Dollars"
Case 5
strTenThousands = Mid$(str, 1, 2)
strHundreds = Mid$(str, 3, 1)
strTens = Mid$(str, 4, 2)
strDollars = NumberToWord(CInt(strTenThousands)) & " Thousand " & _
NumberToWord(CInt(strHundreds)) & " Hundred " & _
NumberToWord(CInt(strTens)) & " Dollars"
Case 6
strHundredThousands = Mid$(str, 1, 1)
strTenThousands = Mid$(str, 2, 2)
strHundreds = Mid$(str, 4, 1)
strTens = Mid$(str, 5, 2)
strDollars = NumberToWord(CInt(strHundredThousands)) & " Hundred " & _
NumberToWord(CInt(strTenThousands)) & " Thousand " & _
NumberToWord(CInt(strHundreds)) & " Hundred " & _
NumberToWord(CInt(strTens)) & " Dollars"
End Select
strReturn = strDollars & strCents
DollarsAndCents = strReturn
End Function
Private Function NumberToWord(i1To99 As Integer) As String
Dim strReturn As String
Dim str1To99 As String
Dim strA As String
Dim strB As String
Dim strTens As String
Dim strOnes As String
str1To99 = CStr(i1To99)
Select Case i1To99
Case "0"
strReturn = ""
Case "1"
strReturn = "One"
Case "2"
strReturn = "Two"
Case "3"
strReturn = "Three"
Case "4"
strReturn = "Four"
Case "5"
strReturn = "Five"
Case "6"
strReturn = "Six"
Case "7"
strReturn = "Seven"
Case "8"
strReturn = "Eight"
Case "9"
strReturn = "Nine"
Case "10"
strReturn = "Ten"
Case "11"
strReturn = "Eleven"
Case "12"
strReturn = "Twelve"
Case "13"
strReturn = "Thirteen"
Case "14"
strReturn = "Fourteen"
Case "15"
strReturn = "Fifteen"
Case "16"
strReturn = "Sixteen"
Case "17"
strReturn = "Seventeen"
Case "18"
strReturn = "Eighteen"
Case "19"
strReturn = "Nineteen"
Case "20"
strReturn = "Twenty"
Case Else
strTens = Mid$(str1To99, 1, 1)
strOnes = Mid$(str1To99, 2, 1)
strB = NumberToWord(CInt(strOnes))
Select Case strTens
Case "1"
strA = "Ten"
Case "2"
strA = "Twenty"
Case "3"
strA = "Thirty"
Case "4"
strA = "Forty"
Case "5"
strA = "Fifty"
Case "6"
strA = "Sixty"
Case "7"
strA = "Seventy"
Case "8"
strA = "Eighty"
Case "9"
strA = "Ninety"
End Select
strReturn = strA & "-" & strB
End Select
NumberToWord = strReturn
End Function
|
|