Function spellnumber(ByVal num)
Dim decimalplace, count As Integer
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Lakh"
Place(4) = " Crore"
Place(5) = " Trillion "
decimalplace = InStr(num, ".")
num = Trim(Str(num))
If decimalplace > 0 Then
'extracting value after decimal
Cents = getTens(Left(Mid(num, (decimalplace + 1), 2) & "00", 2))
'extracting remaining value before decimal
num = Trim(Left(num, decimalplace - 1))
End If
count = 1
Do Until Len(num) = 0
If count = 1 Then
Temp = getHundreds(Right(num, 3), count)
num = Left(num, Len(num) - 3)
ElseIf count > 1 Then
'remaining no. is of two digits
If Len(num) = 2 Then
num = Right(num, Len(num))
Temp = getHundreds(num, count)
num = vbNullString
'remaining no. is of one digit
ElseIf Len(num) = 1 Then
num = Right(num, Len(num))
Temp = getHundreds(num, count)
num = vbNullString
'remaining no. is of more than one digit
ElseIf Len(num) > 2 Then
Temp = getHundreds(Right(num, 2), count)
num = Left(num, Len(num) - 2)
End If
End If
If Temp <> "" Then Dollars = Temp & Place(count) & Dollars
count = count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Rupees"
Case "One"
Dollars = "One Rupees"
Case Else
Dollars = Dollars & " Rupees"
End Select
Select Case Cents
Case ""
Cents = " and No Paisa"
Case "One"
Cents = " and One Paisa"
Case Else
Cents = " and " & Cents & "Paisa"
End Select
spellnumber = Dollars & Cents
End Function
Function getTens(tenstext)
Dim result As String
result = vbNullString
If Val(Left(tenstext, 1)) = 1 Then
Select Case Val(tenstext)
Case 10: result = "Ten"
Case 11: result = "Eleven"
Case 12: result = "Twelve"
Case 13: result = "Thirteen"
Case 14: result = "Fourteen"
Case 15: result = "Fifteen"
Case 16: result = "Sisxteen"
Case 17: result = "Seventeen"
Case 18: result = "Eighteen"
Case 19: result = "Ninteen"
Case Else
End Select
Else
Select Case Val(Left(tenstext, 1))
Case 2: result = "Twenty"
Case 3: result = "Thirty"
Case 4: result = "Fourty"
Case 5: result = "Fifty"
Case 6: result = "Sixty"
Case 7: result = "Seventy"
Case 8: result = "Eighty"
Case 9: result = "Ninety"
Case Else
End Select
result = result & getDigit(Right(tenstext, 1))
'result = result
End If
getTens = result
End Function
Function getDigit(digit)
Select Case Val(digit)
Case 1: getDigit = "One"
Case 2: getDigit = "Two"
Case 3: getDigit = "Three"
Case 4: getDigit = "Four"
Case 5: getDigit = "Five"
Case 6: getDigit = "Six"
Case 7: getDigit = "Seven"
Case 8: getDigit = "Eight"
Case 9: getDigit = "Nine"
Case Else: getDigit = ""
End Select
End Function
Function getHundreds(ByVal number, ByVal count)
Dim result As String
If Val(number) = 0 Then Exit Function
'Extracting last three no. of digit
number = Right(number, Len(number))
If Len(number) = 3 Then
If Mid(number, 1, 1) <> "0" Then
result = getDigit(Mid(number, 1, 1)) & "Hundred"
End If
If Mid(number, 2, 2) <> "0" Then
result = result & getTens(Mid(number, 2, 2))
End If
ElseIf (Len(number) = 2 And (count = 2)) Then
result = getTens(number) & result
ElseIf (Len(number) = 1 And (count = 2)) Then
result = getDigit(number) & result
ElseIf (Len(number) = 2) And (count = 3) Then
result = getTens(number) & result
ElseIf (Len(number) = 1) And (count = 3) Then
result = getDigit(number) & result
ElseIf (Len(number) = 1) And (count = 4) Then
result = getDigit(number) & result
ElseIf (Len(number) = 2) And (count = 4) Then
result = getTens(number) & result
End If
getHundreds = result & getDigit(Right(tenstext, 1))
End Function
No comments:
Post a Comment