VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



Converts any number into the corresponding words in the British Numbering Format (i.e. Thousands, L

by V.Venkatesh (2 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 4th June 2001
Date Added: Mon 8th February 2021
Rating: (1 Votes)

Converts any number into the corresponding words in the British Numbering Format (i.e. Thousands, Lakhs, Crores, etc)

Rate Converts any number into the corresponding words in the British Numbering Format (i.e. Thousands, L




'*******************V.VENKATESHWARAN***********************
'***************E-mail: [email protected]********************
'***************URL: venkat-smart.50megs.com*********************



Public Function NumToText(dblNumber As Double) As String
'On Error GoTo errHandler
'Declarations
Dim Ones(0 To 9) As String
Dim Teens(0 To 9) As String
Dim Tens(0 To 9) As String
Dim Thousands(0 To 4) As String
Dim intLen As Integer
Dim blnOdd As Boolean
Dim intExactLen As Integer
Dim strTmp As String
Dim strTmp1 As String
Dim strVal As String
Dim intAggr As Integer
Dim intTh As Integer
Dim strLen As String
Dim intCtr As Integer
Dim intFind As Integer
Dim intDblAdd As Integer

Ones(0) = "zero"
Ones(1) = "one"
Ones(2) = "two"
Ones(3) = "three"
Ones(4) = "four"
Ones(5) = "five"
Ones(6) = "six"
Ones(7) = "seven"
Ones(8) = "eight"
Ones(9) = "nine"

Teens(0) = "ten"
Teens(1) = "eleven"
Teens(2) = "twelve"
Teens(3) = "thirteen"
Teens(4) = "fourteen"
Teens(5) = "fifteen"
Teens(6) = "sixteen"
Teens(7) = "seventeen"
Teens(8) = "eighteen"
Teens(9) = "nineteen"

Tens(0) = ""
Tens(1) = "ten"
Tens(2) = "twenty"
Tens(3) = "thirty"
Tens(4) = "forty"
Tens(5) = "fifty"
Tens(6) = "sixty"
Tens(7) = "seventy"
Tens(8) = "eighty"
Tens(9) = "ninty"

Thousands(0) = ""
Thousands(1) = "Thousand"
Thousands(2) = "Lakh(s)"
Thousands(3) = "Crore(s)"
Thousands(4) = "Billion"

strLen = CStr(dblNumber)
intLen = Len(strLen)

If intLen > 3 Then
    intExactLen = intLen - 3
    If intExactLen <= 0 Then intTh = 0
    If intExactLen = 1 Or intExactLen = 2 Then intTh = 1
    If intExactLen = 3 Or intExactLen = 4 Then intTh = 2
    If intExactLen = 5 Or intExactLen = 6 Then intTh = 3
    If intExactLen = 7 Or intExactLen = 7 Then intTh = 4
    If intExactLen Mod 2 = 0 Then
        blnOdd = False
    Else
        blnOdd = True
    End If
    If blnOdd = True Then
        strTmp = Mid(dblNumber, 1, 1)
        strVal = Ones(CDbl(strTmp)) + " " + Thousands(intTh)
        intCtr = intAggr + 1
        intFind = (intExactLen - 1) / 2
        intDblAdd = 0
        For intAggr = 0 To intFind
            If intExactLen = 1 Then Exit For
            strTmp = Mid(dblNumber, intDblAdd + 2, 1)
            strTmp1 = Mid(dblNumber, intDblAdd + 3, 1)
            If strTmp = "0" Then
                If strTmp1 <> "0" Then
                strVal = strVal + " " + Ones(CDbl(strTmp1)) + " " + Thousands(intTh - intCtr)
                End If
            ElseIf strTmp = "1" Then
                strVal = strVal + " " + Teens(CDbl(strTmp1)) + " " + Thousands(intTh - intCtr)
            Else
                strVal = strVal + " " + Tens(CDbl(strTmp)) + " " + Ones(CDbl(strTmp1)) + " " + Thousands(intTh - intCtr)
            End If
            intDblAdd = intDblAdd + 2
            intCtr = intCtr + 1
            intExactLen = intExactLen - 2
        Next intAggr
    Else
        intCtr = 0
        intFind = (intExactLen - 1) / 2
        intDblAdd = 0
        For intAggr = 0 To intFind
            If intExactLen = 1 Then Exit For
            strTmp = Mid(dblNumber, intDblAdd + 1, 1)
            strTmp1 = Mid(dblNumber, intDblAdd + 2, 1)
            If strTmp = "0" Then
                If strTmp1 <> "0" Then
                strVal = strVal + " " + Ones(CDbl(strTmp1)) + " " + Thousands(intTh - intCtr)
                End If
            ElseIf strTmp = "1" Then
                strVal = strVal + " " + Teens(CDbl(strTmp1)) + " " + Thousands(intTh - intCtr)
            Else
                If strTmp1 <> "0" Then
                strVal = strVal + " " + Tens(CDbl(strTmp)) + " " + Ones(CDbl(strTmp1)) + " " + Thousands(intTh - intCtr)
                Else
                strVal = strVal + " " + Tens(CDbl(strTmp)) + " " + Thousands(intTh - intCtr)
                End If
            End If
            intDblAdd = intDblAdd + 2
            intCtr = intCtr + 1
            intExactLen = intExactLen - 2
        Next intAggr
    
    End If
    End If
    
    If intLen >= 3 Then
    strTmp = Mid(dblNumber, intLen - 2, 1)
    If strTmp <> "0" Then
    strVal = strVal + " " + Ones(CDbl(strTmp)) + " Hundred"
    End If
    End If
    If intLen >= 2 Then
    strTmp = Mid(dblNumber, intLen - 1, 1)
    If strTmp = "0" Then
    ElseIf strTmp = "1" Then
        strTmp = Mid(dblNumber, intLen, 1)
        strVal = strVal + " " + Teens(CDbl(strTmp))
        NumToText = strVal
        Exit Function
    Else
    strVal = strVal + " " + Tens(CDbl(strTmp))
    End If
    End If
    strTmp = Mid(dblNumber, intLen, 1)
    If strTmp <> "0" Then
    strVal = strVal + " " + Ones(CDbl(strTmp))
End If

If strVal = "" Then strVal = "Zero"
strVal = StrConv(Trim(strVal), vbProperCase)
NumToText = strVal
Exit Function
errHandler:
MsgBox "Sorry!!! Some Internal Error!!! The Request could not be catered!!!", vbCritical, "####ERROR####"
End Function



Dim strString As String
strString = NumToText(CDbl(txtNumber.Text))
strString = Trim(strString)
strString = StrConv(strString, vbProperCase)
MsgBox strString

Download this snippet    Add to My Saved Code

Converts any number into the corresponding words in the British Numbering Format (i.e. Thousands, L Comments

No comments have been posted about Converts any number into the corresponding words in the British Numbering Format (i.e. Thousands, L. Why not be the first to post a comment about Converts any number into the corresponding words in the British Numbering Format (i.e. Thousands, L.

Post your comment

Subject:
Message:
0/1000 characters