Tuesday, May 8, 2012

Convert No.to Text (Upto 10 crore) using VBA


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