Thread: Convert Numbers to Words View Single Post
October 1st, 2007, 07:13 AM
 Tvarun Registered User Join Date: Oct 2007 Location: , , . Posts: 2 Thanks: 0 Thanked 0 Times in 0 Posts

<%
'Max Number = \$999999999999999999999999,99' 24 Digit Number(for Dollar Palce) and 2 Digit number for Cent Place
Function ExpandPrice(pPrice)
Dim temp: temp = ""
Dim expr: Set expr = New RegExp
expr.Pattern = "^\\$(\d+),(\d\d)\$"
If expr.test(pPrice) Then
Dim dollars: dollars = expr.Replace(pPrice, "\$1")
Dim cents: cents = expr.Replace(pPrice, "\$2")
'Response.Write(cents)
If CDbl(dollars) > 1 Then
temp = temp & ExpandNumber(dollars) & " Dollars"
If CDbl(cents) > 0 Then
temp = temp & " And "
End If
ElseIf CDbl(dollars) = 0 Then
temp = temp & ExpandNumber(dollars) & " Zero Dollars "
If CDbl(cents) >= 0 Then
temp = temp & " And "
End If
ElseIf CDbl(dollars) = 1 Then
temp = temp & ExpandNumber(dollars) & " Dollar "
End If

If CDbl(cents) > 1 Then
temp = temp & ExpandNumber(cents) & " Cents"
ElseIf CDbl(cents) = 0 Then
temp = temp & ExpandNumber(cents) & " Zero Cents "
ElseIf CDbl(cents) = 1 Then
temp = temp & ExpandNumber(cents) & " Cent "
End If
End If
Set expr = Nothing
ExpandPrice = temp
End Function

Function ExpandNumber(pNumberStr)
Dim temp: temp = ""
Dim suffixes: suffixes = Array("Thousand ", "Million ", "Billion ", "Trillion ", "Quadrillion ", "Quintillion ", "Sextillion ") ' U.S.
'Dim suffixes: suffixes = Array("Thousand ", "Million ", "Milliard ", "Billion ", "Billiard ", "Trillion ", "Trilliard ") ' European
Dim number: number = String(3 - Len(pNumberStr) Mod 3, "0") & pNumberStr
Dim i, j: j = -1
Dim numPart
For i = Len(number) - 2 To 1 Step -3
numPart = Mid(number, i, 3)
If Clng(numPart > 0) Then
If j > -1 Then
temp = suffixes(j) & temp
End If
temp = GetNumberUnder1000Str(numPart) & temp
End If
j = j + 1
Next
ExpandNumber = temp
End Function

Function GetNumberUnder1000Str(pNumber)
Dim temp: temp = ""
If Len(pNumber) = 3 Then
If CLng(Left(pNumber, 1)) > 0 Then
temp = temp & GetNumberUnder100Str(Left(pNumber, 1)) & " Hundred "
End If
End If
temp = temp & GetNumberUnder100Str(Right("0" & pNumber, 2))
GetNumberUnder1000Str = temp
End Function

Function GetNumberUnder100Str(pNumber)
Dim units: units = Array("", "One ", "Two ", "Three ", "Four ", "Five ", "Six ", "Seven ", "Eight ", "Nine ")
Dim tens: tens = Array("Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
Dim Digits: Digits = Array("Ten ","Eleven ", "Twelve ", "Thirteen ", "Fourteen ", "Fifteen ", "Sixteen ", "Seventeen ", "Eighteen ", "Nineteen")

If pNumber > 19 Then
GetNumberUnder100Str = tens(Left(pNumber, 1) - 2) & units(Right(pNumber, 1))
ElseIF pNumber >= 10 and pNumber <= 19 Then
GetNumberUnder100Str = Digits(Right(pNumber, 1))
Else
GetNumberUnder100Str = units(Right(pNumber, 1))
End If
End Function

'Example : Response.Write ExpandPrice("\$1,99") & "<br />"
Dim vDollar,vCent,vAmount
vDollar = 21121221
vCent = 99
vAmount = "\$"&vDollar&","&vCent
Response.Write vAmount &"<br>"
Response.Write ExpandPrice(vAmount)
%>