• Home
 · 
• Miscellaneous
 · 
• The Modules which converts any number to words. Simply one has to add the module and call the funct

The Modules which converts any number to words. Simply one has to add the module and call the funct

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




Rate The Modules which converts any number to words. Simply one has to add the module and call the funct

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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