Solved

Posted on 2006-04-26

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

4 Comments

http://www.vbexplorer.com/

http://vbcity.com/forums/t

Hope this helps

MilanKM

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

By clicking you are agreeing to Experts Exchange's Terms of Use.

Title | # Comments | Views | Activity |
---|---|---|---|

How to deal with "Consider using Code First Migrations to update the database" ? | 7 | 137 | |

wordsWithout | 49 | 64 | |

Sorting in Excel with Group Headers if the Exist | 2 | 51 | |

drawing animated level bar based on numbers | 3 | 43 |

Join the community of 500,000 technology professionals and ask your questions.

Connect with top rated Experts

**22** Experts available now in Live!