by Loyola_Karthik (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 1st March 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This Code is Used to Convert the Numbers to Text (including the fractional part) I Hope This May Helps U More !
VBcoders
Static ones(0 To 9) As String
Static teens(0 To 9) As String
Static tens(0 To 9) As String
Static thousands(0 To 4) As String
Dim i As Integer, nPosition As Integer
Dim nDigit As Integer, bAllZeros As Integer
Dim strresult As String, strTemp As String
Dim tmpBuff As String
Dim curr As String
Dim a As String
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) = "ninety"
thousands(0) = ""
thousands(1) = "thousand"
thousands(2) = "million"
thousands(3) = "billion"
thousands(4) = "trillion"
'Trap errors
On Error GoTo NumToTextError
'Get fractional part
'strResult = "and " & Format((dblValue - Int(dblValue)) * 100, "00") & "/100"
'strResult = "and " & decToText(Format((dblValue - Int(dblValue)) * 100, "00"))
If Not dblValue = Int(dblValue) Then
strresult = "and " & curr & " " & decToText(Format((dblValue - Int(dblValue)) * 100, "00"))
End If
'Convert rest to string and process each digit
strTemp = CStr(Int(dblValue))
'Iterate through string
For i = Len(strTemp) To 1 Step -1
'Get value of this digit
nDigit = Val(Mid$(strTemp, i, 1))
'Get column position
nPosition = (Len(strTemp) - i) + 1
'Action depends on 1's, 10's or 100's column
Select Case (nPosition Mod 3)
Case 1 '1's position
bAllZeros = False
If i = 1 Then
tmpBuff = ones(nDigit) & " "
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = teens(nDigit) & " "
i = i - 1 'Skip tens position
ElseIf nDigit > 0 Then
tmpBuff = ones(nDigit) & " "
Else
'If next 10s & 100s columns are also
'zero, then don't show 'thousands'
bAllZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
bAllZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
bAllZeros = False
End If
End If
tmpBuff = ""
End If
If bAllZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & thousands(nPosition / 3) & " "
End If
strresult = tmpBuff & strresult
Case 2 'Tens position
If nDigit > 0 Then
strresult = tens(nDigit) & " " & strresult
End If
Case 0 'Hundreds position
If nDigit > 0 Then
strresult = ones(nDigit) & " hundred and " & strresult
End If
End Select
Next i
'Convert first letter to upper case
If Len(strresult) > 0 Then
strresult = UCase$(Left$(strresult, 1)) & Mid$(strresult, 2)
End If
EndNumToText:
NumToText = strresult
a = strresult
Exit Function
NumToTextError:
strresult = "#Error#"
Resume EndNumToText
End Function
Function decToText(dblValue As Double) As String
Static ones(0 To 9) As String
Static teens(0 To 9) As String
Static tens(0 To 9) As String
Static thousands(0 To 4) As String
Dim i As Integer, nPosition As Integer
Dim nDigit As Integer, bAllZeros As Integer
Dim strresult As String, strTemp As String
Dim tmpBuff As String
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) = "ninety"
thousands(0) = ""
thousands(1) = "thousand"
thousands(2) = "million"
thousands(3) = "billion"
thousands(4) = "trillion"
'Trap errors
On Error GoTo dectotextError
'Get fractional part
'strResult = "and " & Format((dblValue - Int(dblValue)) * 100, "00") & "/100"
'strResult = "and " & (Format((dblValue - Int(dblValue)) * 100, "00"))
'Convert rest to string and process each digit
strTemp = CStr(Int(dblValue))
'Iterate through string
For i = Len(strTemp) To 1 Step -1
'Get value of this digit
nDigit = Val(Mid$(strTemp, i, 1))
'Get column position
nPosition = (Len(strTemp) - i) + 1
'Action depends on 1's, 10's or 100's column
Select Case (nPosition Mod 3)
Case 1 '1's position
bAllZeros = False
If i = 1 Then
tmpBuff = ones(nDigit) & " "
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = teens(nDigit) & " "
i = i - 1 'Skip tens position
ElseIf nDigit > 0 Then
tmpBuff = ones(nDigit) & " "
Else
'If next 10s & 100s columns are also
'zero, then don't show 'thousands'
bAllZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
bAllZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
bAllZeros = False
End If
End If
tmpBuff = ""
End If
If bAllZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & thousands(nPosition / 3) & " "
End If
strresult = tmpBuff & strresult
Case 2 'Tens position
If nDigit > 0 Then
strresult = tens(nDigit) & " " & strresult
End If
Case 0 'Hundreds position
If nDigit > 0 Then
strresult = ones(nDigit) & " hundred " & strresult
End If
End Select
Next i
'Convert first letter to upper case
If Len(strresult) > 0 Then
strresult = LCase$(Left$(strresult, 1)) & Mid$(strresult, 2)
End If
Enddectotext:
'Return result
decToText = strresult
Exit Function
dectotextError:
strresult = "#Error#"
Resume Enddectotext
End Function
No comments have been posted about This Code is Used to Convert the Numbers to Text (including the fractional part) I Hope This May He. Why not be the first to post a comment about This Code is Used to Convert the Numbers to Text (including the fractional part) I Hope This May He.