Hi anyone your help will be appreciated
Though adopted the code from below link for converting form figures to words
It seems there is error some how not able to get it right
http://excel-macro.tutorialhorizon.com/vba-excel-convert-numbers-rupees-into-text/
when i type in Textboxfigure.text = 10 or 10.00
I get as Rupees 10 and Paise only where as i would like the desired result to be Rupees Ten Only
Similarly when i type 0.25 i get
Rupees and Twenty Five Paise Only were as i would like to get as Twenty Five Paise only
what corrections needs to be done in the following code
Below is code adopted from
http://excel-macro.tutorialhorizon.com/vba-excel-convert-numbers-rupees-into-text/
in Textbox code
Regards
NimishK
Though adopted the code from below link for converting form figures to words
It seems there is error some how not able to get it right
http://excel-macro.tutorialhorizon.com/vba-excel-convert-numbers-rupees-into-text/
when i type in Textboxfigure.text = 10 or 10.00
I get as Rupees 10 and Paise only where as i would like the desired result to be Rupees Ten Only
Similarly when i type 0.25 i get
Rupees and Twenty Five Paise Only were as i would like to get as Twenty Five Paise only
what corrections needs to be done in the following code
Below is code adopted from
http://excel-macro.tutorialhorizon.com/vba-excel-convert-numbers-rupees-into-text/
Code:
Function FnConvert(strNumber)
blnDecimalExist = False
strNumber = CStr(strNumber)
If InStr(1, strNumber, ".", vbTextCompare) > 0 Then
arrSplit = Split(strNumber, ".")
strNumber = arrSplit(0)
strDecimal = arrSplit(1)
If Len(strDecimal) > 2 Then
strDecimal = Mid(strDecimal, 0, 2)
End If
If Len(strDecimal) > 0 And Len(strDecimal) < 2 Then
strDecimalConversion = FnGetUnitDigit(strDecimal)
End If
If Len(strDecimal) > 1 And Len(strDecimal) < 3 Then
strDecimalConversion = FnGetTensDigit(strDecimal)
End If
blnDecimalExist = True
End If
If Len(strNumber) > 0 And Len(strNumber) < 2 Then
strTextConversion = FnGetUnitDigit(strNumber)
End If
If Len(strNumber) > 1 And Len(strNumber) < 3 Then
strTextConversion = FnGetTensDigit(strNumber)
End If
If Len(strNumber) > 2 And Len(strNumber) < 4 Then
strTextConversion = FnGetHundreds(strNumber)
End If
If Len(strNumber) > 3 And Len(strNumber) < 6 Then
If Len(strNumber) = 4 Then
strTextConversion = FnGetThousandsOne(strNumber)
End If
If Len(strNumber) = 5 Then
strTextConversion = FnGetThousandsTwo(strNumber)
End If
End If
If Len(strNumber) > 5 And Len(strNumber) < 8 Then
If Len(strNumber) = 6 Then
strTextConversion = FnGetLacsOne(strNumber)
End If
If Len(strNumber) = 7 Then
strTextConversion = FnGetLacsTwo(strNumber)
End If
End If
If Len(strNumber) > 7 And Len(strNumber) < 15 Then
If Len(strNumber) = 8 Then
strTextConversion = FnGetCroreOne(strNumber)
End If
If Len(strNumber) = 9 Then
strTextConversion = FnGetCroreTwo(strNumber)
End If
If Len(strNumber) = 10 Then
strTextConversion = FnGetCroreThree(strNumber)
End If
If Len(strNumber) = 11 Then
strTextConversion = FnGetCroreFour(strNumber)
End If
If Len(strNumber) = 12 Then
strTextConversion = FnGetCroreFive(strNumber)
End If
If Len(strNumber) = 13 Then
strTextConversion = FnGetCroreSix(strNumber)
End If
If Len(strNumber) = 14 Then
strTextConversion = FnGetCroreSeven(strNumber)
End If
End If
If blnDecimalExist Then
strTextConversion = "Rupees " & strTextConversion & " and " & strDecimalConversion & " paise only"
Else
strTextConversion = "Rupees " & strTextConversion
End If
FnConvert = strTextConversion
End Function
Function FnGetCroreSeven(intN)
Dim Str
'temp = FnGetTensDigit(Left(intN, 3))
'If temp <> "" Then
Str = FnGetLacsTwo(Left(intN, 7)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 7))
'Else
' Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
'End If
FnGetCroreSeven = Str
End Function
Function FnGetCroreSix(intN)
Dim Str
'temp = FnGetTensDigit(Left(intN, 3))
'If temp <> "" Then
Str = FnGetLacsOne(Left(intN, 6)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 6))
'Else
' Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
'End If
FnGetCroreSix = Str
End Function
Function FnGetCroreFive(intN)
Dim Str
'temp = FnGetTensDigit(Left(intN, 3))
'If temp <> "" Then
Str = FnGetThousandsTwo(Left(intN, 5)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 5))
'Else
' Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
'End If
FnGetCroreFive = Str
End Function
Function FnGetCroreFour(intN)
Dim Str
'temp = FnGetTensDigit(Left(intN, 3))
'If temp <> "" Then
Str = FnGetThousandsOne(Left(intN, 4)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 4))
'Else
' Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
'End If
FnGetCroreFour = Str
End Function
Function FnGetCroreThree(intN)
Dim Str
'temp = FnGetTensDigit(Left(intN, 3))
'If temp <> "" Then
Str = FnGetHundreds(Left(intN, 3)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 3))
'Else
' Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
'End If
FnGetCroreThree = Str
End Function
Function FnGetCroreTwo(intN)
Dim Str
temp = FnGetTensDigit(Left(intN, 2))
If temp <> "" Then
Str = FnGetTensDigit(Left(intN, 2)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 2))
Else
Str = FnGetLacsTwo(Right(intN, Len(intN) - 2))
End If
FnGetCroreTwo = Str
End Function
Function FnGetCroreOne(intN)
Dim Str
temp = FnGetUnitDigit(Left(intN, 1))
If temp <> "" Then
Str = FnGetUnitDigit(Left(intN, 1)) & " Crore " & FnGetLacsTwo(Right(intN, Len(intN) - 1))
Else
Str = FnGetLacsTwo(Right(intN, Len(intN) - 1))
End If
FnGetCroreOne = Str
End Function
Function FnGetLacsTwo(intN)
Dim Str
temp = FnGetTensDigit(Left(intN, 2))
If temp <> "" Then
Str = FnGetTensDigit(Left(intN, 2)) & " Lacs " & FnGetThousandsTwo(Right(intN, Len(intN) - 2))
Else
Str = FnGetThousandsTwo(Right(intN, Len(intN) - 2))
End If
FnGetLacsTwo = Str
End Function
Function FnGetLacsOne(intN)
Dim Str
'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
temp = FnGetUnitDigit(Left(intN, 1))
If temp <> "" Then
Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
Else
Str = FnGetThousandsTwo(Right(intN, Len(intN) - 1))
End If
FnGetLacsOne = Str
End Function
Function FnGetThousandsTwo(intN)
Dim Str
'Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
temp = FnGetTensDigit(Left(intN, 2))
If temp <> "" Then
Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
Else
Str = FnGetHundreds(Right(intN, Len(intN) - 2))
End If
FnGetThousandsTwo = Str
End Function
Function FnGetThousandsOne(intN)
Dim Str
'Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
temp = FnGetUnitDigit(Left(intN, 1))
If temp <> "" Then
Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
Else
Str = FnGetHundreds(Right(intN, Len(intN) - 1))
End If
FnGetThousandsOne = Str
End Function
Function FnGetHundreds(intN)
Dim Str
temp = FnGetUnitDigit(Left(intN, 1))
If temp <> "" Then
Str = FnGetUnitDigit(Left(intN, 1)) & " Hundred " & FnGetTensDigit(Right(intN, 2))
Else
Str = FnGetTensDigit(Right(intN, 2))
End If
FnGetHundreds = Trim(Str)
End Function
Function FnGetTensDigit(intN)
Dim Str
If Left(intN, 1) = 1 Then
Select Case Val(intN)
Case 10: Str = "Ten"
Case 11: Str = "Eleven"
Case 12: Str = "Twelve"
Case 13: Str = "Thirteen"
Case 14: Str = "Fourteen"
Case 15: Str = "Fifteen"
Case 16: Str = "Sixteen"
Case 17: Str = "Seventeen"
Case 18: Str = "Eighteen"
Case 19: Str = "Nineteen"
End Select
Else
Select Case Val(Left(intN, 1))
Case 2: Str = "Twenty"
Case 3: Str = "Thirty"
Case 4: Str = "Fourty"
Case 5: Str = "Fifty"
Case 6: Str = "Sixty"
Case 7: Str = "Seventy"
Case 8: Str = "Eighty"
Case 9: Str = "Ninty"
End Select
Str = Str & " " & FnGetUnitDigit(Right(intN, 1))
End If
FnGetTensDigit = Trim(Str)
End Function
Function FnGetUnitDigit(intN)
Dim Str
Select Case Val(intN)
Case 1: Str = "One"
Case 2: Str = "Two"
Case 3: Str = "Three"
Case 4: Str = "Four"
Case 5: Str = "Five"
Case 6: Str = "Six"
Case 7: Str = "Seven"
Case 8: Str = "Eight"
Case 9: Str = "Nine"
End Select
FnGetUnitDigit = Trim(Str)
End Function
in Textbox code
Code:
Private Sub textboxFigure_Change()
If textboxFigure.Text = "" Then
textboxWords.Text = ""
Else
textboxWords.Text = FnConvert(Format(textboxFigure.Text, "#.##"))
End If
End Sub
Regards
NimishK
Last edited: