menkiz
asked on
Convert a Number to Words/Text
Hi all,
I am developing a receipting system and I want to take the amount paid; let say
$157.57 and convert that into to words being:
One Hundred Fifty Seven Dollars and Fifity Seven Cents.....
Is there any way I accomplish this in VB or VBA...
Thanks for you eager response...
menkiz
I am developing a receipting system and I want to take the amount paid; let say
$157.57 and convert that into to words being:
One Hundred Fifty Seven Dollars and Fifity Seven Cents.....
Is there any way I accomplish this in VB or VBA...
Thanks for you eager response...
menkiz
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Exactly what I needed......
Here's a version I wrote up specificaly for Currency, supporting large numbers
Option Explicit
' Converts a String Dollar and Cents value like $123.45
' into a worded string value like One Hundred twenty-three dollars and Fourty-Five cents
'========================= ========== ========== ======
' Function: CurrencyToWords
' Parameter: Amount To convert, a string representation of a currency amount (Dollars)
' Returns: A Enlish Text Word representation of the Currency value
'========================= ========== ========== ======
Function CurrencyToWords(AmountToCo nvert)
Dim TempString
Dim AmountSplit
Dim Dollars
Dim Cents
AmountSplit = Split(AmountToConvert, ".")
If Left(AmountSplit(0), 1) = "$" Then AmountSplit(0) = Right(AmountSplit(0), Len(AmountSplit(0)) - 1) 'Remove the Dollar Sign
Dollars = NumberToWords(AmountSplit( 0))
If (UBound(AmountSplit) - LBound(AmountSplit)) >= 1 Then
Cents = NumberToWords(AmountSplit( 1))
Else
Cents = ""
End If
If (Len(Dollars) > 0) Then TempString = Dollars & " Dollars"
If (Len(Cents) > 0) Then
If (Len(TempString) > 0) Then TempString = TempString & " and "
TempString = TempString & Cents & " Cents"
End If
CurrencyToWords = TempString
End Function
'========================= ========== ========== =====
' Function NumberToWords
' Converts a Whole number into a word string representation
'========================= ========== ========== =====
Function NumberToWords(NumbersToCon vert)
Dim TempString
Dim TempNumbers
Dim OnesPlace
Dim TensPlace
Dim HundresPlace
Dim Numbers
Dim Tens
Dim Powers
Dim PowersLoop
Dim TempThousandsNum
Dim TempThousandsWords
Numbers = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
Tens = Array("", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
Powers = Array("", "Thousand", "Million", "Billion", "Trillion", "Quadrillion", "Quintillion", "Sextillion")
TempNumbers = StrReverse(NumbersToConver t) ' Reverse the string so the numbers increase in String order
For PowersLoop = 1 To (Len(TempNumbers)) Step 3 'Breaks the string up into Thousands
TempThousandsNum = Mid(TempNumbers, PowersLoop, 3)
OnesPlace = CInt(Mid(TempThousandsNum, 1, 1))
TensPlace = 0
HundresPlace = 0
If (Len(TempThousandsNum) >= 2) Then
TensPlace = CInt(Mid(TempThousandsNum, 2, 1))
End If
If (Len(TempThousandsNum) >= 3) Then
HundresPlace = CInt(Mid(TempThousandsNum, 3, 1))
End If
TempThousandsWords = Numbers(OnesPlace)
If (TensPlace > 1) Then
TempThousandsWords = Tens(TensPlace) & "-" & TempThousandsWords
Else
TempThousandsWords = Numbers((TensPlace * 10) + OnesPlace)
End If
If (HundresPlace >= 1) Then TempThousandsWords = Numbers(HundresPlace) & " Hundred and " & TempThousandsWords
TempThousandsWords = Trim(TempThousandsWords)
If PowersLoop \ 3 > 0 Then TempThousandsWords = TempThousandsWords & " " & Powers(PowersLoop \ 3) & ","
If (Len(TempThousandsWords) > 0) Then TempString = TempThousandsWords & " " & TempString
Next
NumberToWords = Trim(TempString)
End Function
Option Explicit
' Converts a String Dollar and Cents value like $123.45
' into a worded string value like One Hundred twenty-three dollars and Fourty-Five cents
'=========================
' Function: CurrencyToWords
' Parameter: Amount To convert, a string representation of a currency amount (Dollars)
' Returns: A Enlish Text Word representation of the Currency value
'=========================
Function CurrencyToWords(AmountToCo
Dim TempString
Dim AmountSplit
Dim Dollars
Dim Cents
AmountSplit = Split(AmountToConvert, ".")
If Left(AmountSplit(0), 1) = "$" Then AmountSplit(0) = Right(AmountSplit(0), Len(AmountSplit(0)) - 1) 'Remove the Dollar Sign
Dollars = NumberToWords(AmountSplit(
If (UBound(AmountSplit) - LBound(AmountSplit)) >= 1 Then
Cents = NumberToWords(AmountSplit(
Else
Cents = ""
End If
If (Len(Dollars) > 0) Then TempString = Dollars & " Dollars"
If (Len(Cents) > 0) Then
If (Len(TempString) > 0) Then TempString = TempString & " and "
TempString = TempString & Cents & " Cents"
End If
CurrencyToWords = TempString
End Function
'=========================
' Function NumberToWords
' Converts a Whole number into a word string representation
'=========================
Function NumberToWords(NumbersToCon
Dim TempString
Dim TempNumbers
Dim OnesPlace
Dim TensPlace
Dim HundresPlace
Dim Numbers
Dim Tens
Dim Powers
Dim PowersLoop
Dim TempThousandsNum
Dim TempThousandsWords
Numbers = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
Tens = Array("", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
Powers = Array("", "Thousand", "Million", "Billion", "Trillion", "Quadrillion", "Quintillion", "Sextillion")
TempNumbers = StrReverse(NumbersToConver
For PowersLoop = 1 To (Len(TempNumbers)) Step 3 'Breaks the string up into Thousands
TempThousandsNum = Mid(TempNumbers, PowersLoop, 3)
OnesPlace = CInt(Mid(TempThousandsNum,
TensPlace = 0
HundresPlace = 0
If (Len(TempThousandsNum) >= 2) Then
TensPlace = CInt(Mid(TempThousandsNum,
End If
If (Len(TempThousandsNum) >= 3) Then
HundresPlace = CInt(Mid(TempThousandsNum,
End If
TempThousandsWords = Numbers(OnesPlace)
If (TensPlace > 1) Then
TempThousandsWords = Tens(TensPlace) & "-" & TempThousandsWords
Else
TempThousandsWords = Numbers((TensPlace * 10) + OnesPlace)
End If
If (HundresPlace >= 1) Then TempThousandsWords = Numbers(HundresPlace) & " Hundred and " & TempThousandsWords
TempThousandsWords = Trim(TempThousandsWords)
If PowersLoop \ 3 > 0 Then TempThousandsWords = TempThousandsWords & " " & Powers(PowersLoop \ 3) & ","
If (Len(TempThousandsWords) > 0) Then TempString = TempThousandsWords & " " & TempString
Next
NumberToWords = Trim(TempString)
End Function
http://www.vbexplorer.com/VBExplorer/tips/src36.asp
http://vbcity.com/forums/topic.asp?tid=6785
Hope this helps
MilanKM