by Angsuman Banerji (23 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 6th November 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
The Modules which converts any number to words. Simply one has to add the module and call the function from the main form and use in pleasure
API Declarations
'
' Constants
'
Private Const Ones As String = "one two three four five six seven eight nine ten " ' 1 - 9 : Six characters each
Private Const Teens As String = "eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen " ' 11 - 19 : Ten characters each
Private Const Tens As String = " twenty thirty forty fifty sixty seventy eighty ninety " ' 10,20 .. 90 : Eight characters each
Private Const USThousands As String = "thousand million billion trillion quadrillion " ' US Thousands : 12 characters each
VBcoders
Optional ByVal DecimalPoint As String = ".", Optional ByVal CurrencySymbol As String = "$", Optional ByVal CentsSuffix As String = "Cents") As String
Dim strWhole As String
Dim strDecimal As String
Dim strDecimalwords As String
Dim strTemp As String
Dim tempNum As Long
Dim I As Long
Dim strPart As String
Dim bNegative As Boolean
If Not IsNumeric(strNumber) Then Exit Function
If Val(strNumber) = 0 Then
NumberToWords = "Zero"
If CurrencyFormat Then
NumberToWords = CurrencySymbol & " " & NumberToWords
End If
Exit Function
End If
If Sgn(strNumber) = -1 Then
bNegative = True
strNumber = Mid$(strNumber, 2)
End If
' Get Decimal Part
tempNum = InStr(strNumber, DecimalPoint)
If tempNum > 0 Then
If CurrencyFormat Then
strDecimal = Mid$(strNumber, tempNum + 1)
If strDecimal <> "" Then
If Val(strDecimal) > 0 Then
If Len(strDecimal) > 2 Then
strDecimal = Left$(strDecimal, 2) & "." & Mid$(strDecimal, 3) ' 123.505 == 50.5
ElseIf Len(strDecimal) = 1 Then
strDecimal = strDecimal & "0" ' 123.5 equates to 123.50
End If
strDecimalwords = " and " & NumbersUpto99(CLng(strDecimal)) & " " & CentsSuffix
End If
End If
Else
strDecimal = Mid$(strNumber, tempNum + 1)
If strDecimal <> "" Then
If Val(strDecimal) > 0 Then
For I = 1 To Len(strDecimal)
strDecimalwords = strDecimalwords & " " & StripPart(Ones, CLng(Mid$(strDecimal, I, 1)) - 1, 6)
Next
strDecimalwords = DecimalPoint & strDecimalwords
End If
End If
End If
strWhole = Left$(strNumber, tempNum - 1)
Else
strWhole = strNumber
End If
If FormatIndian Then
' Since Indian Format follows the pattern of repeating the pattern once every 7 numbers i.e., 99,99,999 (1 crore - 1)
' We split the number into parts of 7 numbers each
If (Len(strWhole) Mod 7) <> 0 Then
tempNum = 7 - (Len(strWhole) Mod 7)
strWhole = String(tempNum, "0") & strWhole
End If
If Len(strWhole) = 7 Then
NumberToWords = NumbersUptoCrore(CLng(strWhole))
NumberToWords = NumberToWords & strDecimalwords
NumberToWords = Trim$(NumberToWords)
If Len(NumberToWords) > 0 Then
NumberToWords = UCase(Left$(NumberToWords, 1)) & Mid$(NumberToWords, 2)
End If
If CurrencyFormat Then
NumberToWords = CurrencySymbol & " " & NumberToWords
End If
If bNegative Then
NumberToWords = "- " & NumberToWords
End If
Exit Function
End If
Do While Len(strWhole) > 0
strTemp = Left$(strWhole, 7)
If Len(strWhole) > 7 Then
strWhole = Mid$(strWhole, 8)
Else
strWhole = ""
End If
strPart = NumbersUptoCrore(CLng(strTemp))
If Len(strPart) > 0 Then
If NumberToWords = "" Then
NumberToWords = strPart
Else
NumberToWords = NumberToWords & " crore " & strPart
End If
End If
Loop
Else
If (Len(strWhole) Mod 3) <> 0 Then
tempNum = 3 - (Len(strWhole) Mod 3)
strWhole = String(tempNum, "0") & strWhole
End If
If Len(strWhole) = 3 Then
NumberToWords = NumbersUpto999(CLng(strWhole))
NumberToWords = NumberToWords & strDecimalwords
NumberToWords = Trim$(NumberToWords)
If Len(NumberToWords) > 0 Then
NumberToWords = UCase(Left$(NumberToWords, 1)) & Mid$(NumberToWords, 2)
End If
If CurrencyFormat Then
NumberToWords = CurrencySymbol & " " & NumberToWords
End If
If bNegative Then
NumberToWords = "- " & NumberToWords
End If
Exit Function
End If
I = -1 ' the part to Strip in the USThousands String Constant
Do While Len(strWhole) > 0
strTemp = Right$(strWhole, 3)
If Len(strWhole) > 3 Then
strWhole = Left$(strWhole, Len(strWhole) - 3)
Else
strTemp = strWhole
strWhole = ""
End If
strPart = NumbersUpto999(CLng(strTemp))
If Len(strPart) > 0 Then
If NumberToWords = "" Then
NumberToWords = strPart
Else
NumberToWords = strPart & " " & StripPart(USThousands, I, 12) & " " & NumberToWords
End If
End If
I = I + 1
Loop
End If
NumberToWords = NumberToWords & strDecimalwords
NumberToWords = Trim$(NumberToWords)
If Len(NumberToWords) > 0 Then
NumberToWords = UCase(Left$(NumberToWords, 1)) & Mid$(NumberToWords, 2)
End If
If CurrencyFormat Then
NumberToWords = CurrencySymbol & " " & NumberToWords
End If
End Function
Private Function NumbersUptoCrore(ByVal mNumber As Long) As String
'
' Converts the Numbers from 0 => (1 Crore - 1)
'
Dim tempVal As Long
Dim tempStr As String
If mNumber > 9999999 Then Exit Function ' Overflow
' Get the Lakhs Part
If mNumber > 99999 And mNumber <= 9999999 Then
tempVal = mNumber \ 100000 ' The Lakhs alone
mNumber = mNumber Mod 100000 ' The Rest of it
tempStr = NumbersUpto99(tempVal) & " lakh "
End If
' Get the Thousands Part
If mNumber > 999 And mNumber <= 99999 Then
tempVal = mNumber \ 1000 ' The Thousands alone
mNumber = mNumber Mod 1000 ' The Rest of it
tempStr = tempStr & NumbersUpto99(tempVal) & " thousand "
End If
' Get the Hundreds Part
NumbersUptoCrore = Trim$(tempStr)
tempStr = NumbersUpto999(mNumber)
If Len(tempStr) > 0 Then
NumbersUptoCrore = NumbersUptoCrore & " " & tempStr
End If
End Function
Private Function NumbersUpto999(ByVal NumLessThan1000 As Long) As String
'
' Returns the String for Numbers between 0 - 999
'
Dim tempCalc As Long
Dim tempString As String
If NumLessThan1000 <= 0 Or NumLessThan1000 > 999 Then Exit Function
If NumLessThan1000 > 99 Then
tempCalc = (NumLessThan1000 \ 100) - 1
NumLessThan1000 = NumLessThan1000 Mod 100
NumbersUpto999 = StripPart(Ones, tempCalc, 6) & " hundred"
End If
tempString = Trim$(NumbersUpto99(NumLessThan1000))
If Len(NumbersUpto999) > 0 And Len(tempString) > 0 Then
NumbersUpto999 = NumbersUpto999 & " and " & tempString
Else
NumbersUpto999 = NumbersUpto999 & tempString
End If
NumbersUpto999 = Trim$(NumbersUpto999)
End Function
Private Function NumbersUpto99(ByVal NumLessThan99 As Long) As String
'
' Often required : Converts Numbers from 0 - 99 and then returns the result
'
Dim tempCalc As Long
Dim tempString As String
If NumLessThan99 <= 0 Or NumLessThan99 > 99 Then Exit Function
'
' Check : Number : 11 - 19 => Return Directly
' Number : 10 - 99 => Strip Tens Part and Singles Part
'
If NumLessThan99 >= 11 And NumLessThan99 <= 19 Then
tempCalc = NumLessThan99 - 11
NumbersUpto99 = StripPart(Teens, tempCalc, 10)
Exit Function
End If
If NumLessThan99 > 10 Then ' Tens Part has to be converted
tempCalc = (NumLessThan99 \ 10) - 1 ' tens part
NumLessThan99 = NumLessThan99 Mod 10 ' singles part : the remaining
NumbersUpto99 = StripPart(Tens, tempCalc, 8)
End If
'
' Number contains a single digit number. If it is zero, we need not add anything
' to the Tens Part if it exists. Otherwise, convert the Singles Part and add to
' the result
'
If NumLessThan99 > 0 Then
tempString = StripPart(Ones, NumLessThan99 - 1, 6)
If NumbersUpto99 <> "" Then ' There's a Tens Part
NumbersUpto99 = NumbersUpto99 & " " & tempString
Else
NumbersUpto99 = tempString
End If
End If
NumbersUpto99 = Trim$(NumbersUpto99)
End Function
Private Function StripPart(ByVal EntireString As String, _
ByVal NumberToConvert As Long, _
ByVal Offset As Long) As String
'
' Strips the required Part of the String corresponding to the passed
' NumberToConvert argument and returns the result
'
If NumberToConvert = -1 Then
StripPart = "zero" ' Special Case for Numbers
Else
StripPart = Trim$(Mid$(EntireString, NumberToConvert * Offset + 1, Offset))
End If
End Function
No comments have been posted about The Modules which converts any number to words. Simply one has to add the module and call the funct. Why not be the first to post a comment about The Modules which converts any number to words. Simply one has to add the module and call the funct.
