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)
'*******************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
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.