Friday, September 7, 2012

Excel -ல் ரூபாய் எழுத்தில்

எக்ஸல்லில் ரூபாய் வாக்கியமாக தோன்ற.



நாம் எக்ஸல்லில் சில டாக்குமெண்ட் தயாரிக்கும்பொழுது ரூபாய் மதிப்பை எழுத்தால் எழுத வேண்டியிருக்கும். அந்த சமயங்களில் ரூபாயின் மதிப்பை தானாக ஒரு செல்லில் உருவாக்க எக்ஸல் ஷீட்டில் கீழ் கண்டவாறு மேக்ரோ உருவாக்க வேண்டும்.
1.        ஒரு எக்ஸல் டாக்குமெண்ட்டை திறக்கவும்
2.        ALT+F11 ஐ ஒருசேர அழுத்தவும்.
3.        இப்பொழுது தோன்றும் Microsoft visual Basic for Application ல் insert  என்பதை   கிளிக் செய்து அதில் module என்பதை கிளிக் செய்யவும்.
4.       அதில் தோன்றும் பெட்டியில் கீழ் கண்ட Program copy செய்து Paste     செய்யவும்.

Function SpellCurr(ByVal MyNumber, _
Optional MyCurrency As String = "Rupee", _
Optional MyCurrencyPlace As String = "P", _
Optional MyCurrencyDecimals As String = "Paisa", _
Optional MyCurrencyDecimalsPlace As String = "S")
 Dim Rupees, Paisa, Temp
          Dim DecimalPlace, Count   
          ReDim Place(9) As String
          Place(2) = " Thousand "
          Place(3) = " Million "
          Place(4) = " Billion "
          Place(5) = " Trillion "     
          'String representation of amount.
          MyNumber = Trim(Str(MyNumber))     
          'Position of decimal place 0 if none.
          DecimalPlace = InStr(MyNumber, ".")     
          ' Convert Paisa and set MyNumber to Rupee amount.
          If DecimalPlace > 0 Then
              Paisa = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "00", 2))
              MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
          End If
          Count = 1
          Do While MyNumber <> ""
              Temp = GetHundreds(Right(MyNumber, 3))
              If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
              If Len(MyNumber) > 3 Then
                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)
              Else
                  MyNumber = ""
              End If
              Count = Count + 1
          Loop
       
            If MyCurrencyPlace = "P" Then
                Select Case Rupees
                    Case ""
                        Rupees = MyCurrency & "s" & " Zero"
                    Case "One"
                        Rupees = MyCurrency & " One"
                    Case Else
                        Rupees = MyCurrency & "s " & Rupees
                End Select
            Else
                Select Case Rupees
                    Case ""
                        Rupees = "Zero " & MyCurrency & "s"
                    Case "One"
                        Rupees = "One " & MyCurrency
                    Case Else
                        Rupees = Rupees & " " & MyCurrency & "s"
                End Select
            End If       
          If MyCurrencyDecimalsPlace = "S" Then
                Select Case Paisa
                    Case ""
                        Paisa = " Only"
                    Case "One"
                        Paisa = " and One " & MyCurrencyDecimals & " Only"
                    Case Else
                        Paisa = " and " & Paisa & " " & MyCurrencyDecimals & "s Only"
                End Select
          Else
                Select Case Paisa
                    Case ""
                        Paisa = " Only"
                    Case "One"
                        Paisa = " and " & MyCurrencyDecimals & " One " & " Only"
                    Case Else
                        Paisa = " and " & MyCurrencyDecimals & "s " & Paisa & " Only"
                End Select
          End If
     
          SpellCurr = Rupees & Paisa

      End Function
      '*******************************************
      ' Converts a number from 100-999 into text *
      '******************************************* 
      Function GetHundreds(ByVal MyNumber)
          Dim Result As String
          If Val(MyNumber) = 0 Then Exit Function
          MyNumber = Right("000" & MyNumber, 3)
          ' Convert the hundreds place.
          If Mid(MyNumber, 1, 1) <> "0" Then
              Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
          End If
          ' Convert the tens and ones place.
          If Mid(MyNumber, 2, 1) <> "0" Then
              Result = Result & GetTens(Mid(MyNumber, 2))
          Else
              Result = Result & GetDigit(Mid(MyNumber, 3))
          End If
          GetHundreds = Result
      End Function
      '*********************************************
      ' Converts a number from 10 to 99 into text. *
      '*********************************************
     Function GetTens(TensText)
          Dim Result As String
          Result = ""           ' Null out the temporary function value.
          If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
              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 = "Sixteen"
                  Case 17: Result = "Seventeen"
                  Case 18: Result = "Eighteen"
                  Case 19: Result = "Nineteen"
                  Case Else
              End Select
          Else                                 ' If value between 20-99...
              Select Case Val(Left(TensText, 1))
                  Case 2: Result = "Twenty "
                  Case 3: Result = "Thirty "
                  Case 4: Result = "Forty "
                  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))  ' Retrieve ones place.
          End If
          GetTens = Result
      End Function
      '*******************************************
      ' Converts a number from 1 to 9 into text. *
      '*******************************************
      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
5    பிறகு Microsoft visual Basic for Application close செய்து எக்ஸல் ஷீட்டிற்கு  சென்று கீழ்கண்ட Formula மூலம் ரூபாயை  வாக்கியத்தில்  பெறலாம்.
6.       A4 செல்லில் இருக்கும் ரூபாயை வாக்கியத்தில் மாற்ற  =SpellCurr(A4)   என்ற FORMULA வை பயன்படுத்தலாம்.
7.        இவ்வாறு மேக்ரோ இணைக்கப்பட எக்ஸல் ஷீட்டை சேவ் செய்யும்  பொழுது கீழ்கண்ட டயலாக் பாக்ஸ் தோன்றும்.


8.    அப்பொழுது NO என்று கொடுத்து SAVE AS TYPEல்
Excel Macro-Enabled workbook என்பதை தேர்ந்தெடுத்து சேவ் செய்யவும்.

Author : Ganesan MG // 10:42 PM

1 comments:

  1. தயவு செய்து தமிழில் ரூபாய் எழுத்தொடர் வரவைக்கும் உத்திகளை குறிப்பிடுமாறு வேண்டப்படுகிறது.

    ReplyDelete

 
Powered by Blogger.

Followers