Watch out video, how to apply below code.
Copy the below code and paste under module
Public Function Spellnumber(SNum As String)
'Updateby Extendoffice
Dim xDPInt As Integer
Dim xArrPlace As Variant
Dim xRStr_ As String
Dim xNumStr As String
Dim xF As Integer
Dim xTemp As String
Dim xStrTemp As String
Dim xRStr As String
Dim xLp As Integer
xArrPlace = Array("", "", " Thousand ", " Lacs ", " Crores ", " Trillion ", "", "", "", "")
On Error Resume Next
If SNum = "" Then
Spellnumber = ""
Exit Function
End If
xNumStr = Trim(Str(SNum))
If xNumStr = "" Then
Spellnumber = ""
Exit Function
End If
xRStr = ""
xLp = 0
If (xNumStr > 999999999.99) Then
Spellnumber = "Digit excced Maximum limit"
Exit Function
End If
xDPInt = InStr(xNumStr, ".")
If xDPInt > 0 Then
If (Len(xNumStr) - xDPInt) = 1 Then
xRStr_ = Spellnumber_GetT(Left(Mid(xNumStr, xDPInt + 1) & "0", 2))
ElseIf (Len(xNumStr) - xDPInt) > 1 Then
xRStr_ = Spellnumber_GetT(Left(Mid(xNumStr, xDPInt + 1), 2))
End If
xNumStr = Trim(Left(xNumStr, xDPInt - 1))
End If
xF = 1
Do While xNumStr <> ""
If (xF >= 2) Then
xTemp = Right(xNumStr, 2)
Else
If (Len(xNumStr) = 2) Then
xTemp = Right(xNumStr, 2)
ElseIf (Len(xNumStr) = 1) Then
xTemp = Right(xNumStr, 1)
Else
xTemp = Right(xNumStr, 3)
End If
End If
xStrTemp = ""
If Val(xTemp) > 99 Then
xStrTemp = Spellnumber_GetH(Right(xTemp, 3), xLp)
If Right(Trim(xStrTemp), 3) <> "Lac" Then
xLp = xLp + 1
End If
ElseIf Val(xTemp) <= 99 And Val(xTemp) > 9 Then
xStrTemp = Spellnumber_GetT(Right(xTemp, 2))
ElseIf Val(xTemp) < 10 Then
xStrTemp = Spellnumber_GetD(Right(xTemp, 2))
End If
If xStrTemp <> "" Then
xRStr = xStrTemp & xArrPlace(xF) & xRStr
End If
If xF = 2 Then
If Len(xNumStr) = 1 Then
xNumStr = ""
Else
xNumStr = Left(xNumStr, Len(xNumStr) - 2)
End If
ElseIf xF = 3 Then
If Len(xNumStr) >= 3 Then
xNumStr = Left(xNumStr, Len(xNumStr) - 2)
Else
xNumStr = ""
End If
ElseIf xF = 4 Then
xNumStr = ""
Else
If Len(xNumStr) <= 2 Then
xNumStr = ""
Else
xNumStr = Left(xNumStr, Len(xNumStr) - 3)
End If
End If
xF = xF + 1
Loop
If xRStr = "" Then
xRStr = "No"
Else
xRStr = xRStr
End If
If xRStr_ <> "" Then
xRStr_ = " Point " & xRStr_ & " "
End If
Spellnumber = xRStr & xRStr_
End Function
Function Spellnumber_GetH(xStrH As String, xLp As Integer)
Dim xRStr As String
If Val(xStrH) < 1 Then
Spellnumber_GetH = ""
Exit Function
Else
xStrH = Right("000" & xStrH, 3)
If Mid(xStrH, 1, 1) <> "0" Then
If (xLp > 0) Then
xRStr = Spellnumber_GetD(Mid(xStrH, 1, 1)) & " Lac "
Else
xRStr = Spellnumber_GetD(Mid(xStrH, 1, 1)) & " Hundred "
End If
End If
If Mid(xStrH, 2, 1) <> "0" Then
xRStr = xRStr & Spellnumber_GetT(Mid(xStrH, 2))
Else
xRStr = xRStr & Spellnumber_GetD(Mid(xStrH, 3))
End If
End If
Spellnumber_GetH = xRStr
End Function
Function Spellnumber_GetT(xTStr As String)
Dim xTArr1 As Variant
Dim xTArr2 As Variant
Dim xRStr As String
xTArr1 = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
xTArr2 = Array("", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
Result = ""
If Val(Left(xTStr, 1)) = 1 Then
xRStr = xTArr1(Val(Mid(xTStr, 2, 1)))
Else
If Val(Left(xTStr, 1)) > 0 Then
xRStr = xTArr2(Val(Left(xTStr, 1)) - 1)
End If
xRStr = xRStr & Spellnumber_GetD(Right(xTStr, 1))
End If
Spellnumber_GetT = xRStr
End Function
Function Spellnumber_GetD(xDStr As String)
Dim xArr_1() As Variant
xArr_1 = Array(" One", " Two", " Three", " Four", " Five", " Six", " Seven", " Eight", " Nine", "")
If Val(xDStr) > 0 Then
Spellnumber_GetD = xArr_1(Val(xDStr) - 1)
Else
Spellnumber_GetD = ""
End If
End Function
No comments:
Post a Comment