Wednesday, December 7, 2016

MS Excel Currency converter VBA code

Copy paste this VBA code into your Excel VBA eidotr module. Or Insert an empty module and paste this code.
  1. Attribute VB_Name = "Module1"
  2. 'Attribute VB_Name = "Module2"
  3. ' ****  Author          : Krishna S
  4. ' ****  Tittle          : Converting Hindu Arabic Currency(Indian System) to Words
  5. ' ****  Copyright Owner : Krishna S
  6. ' ****  Description     : This utility converts currencies in Indian numbering system to words.
  7. ' ****  Limitations     : Converts only upto 10,00,00,000( Ten Crores)

  8. Function ConvertCurrencyToEnglish(ByVal MyNumber)
  9. Dim Temp
  10.          Dim Rupees, Paise
  11.          Dim DecimalPlace, Count
  12.          ReDim Place(9) As String
  13.          Place(2) = " Thousand "
  14.          Place(3) = " Lac "
  15.          Place(4) = " Core "
  16.       '   Place(5) = " Hundred Core "
  17.          ' Convert MyNumber to a string, trimming extra spaces.
  18.          MyNumber = Trim(Str(MyNumber))
  19.          ' Find decimal place.
  20.          DecimalPlace = InStr(MyNumber, ".")
  21.          ' If we find decimal place...
  22.          If DecimalPlace > 0 Then
  23.             ' Convert Paise
  24.             Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
  25.             Paise = ConvertTens(Temp)
  26.             ' Strip off Paise from remainder to convert.
  27.             MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
  28.          End If
  29.          Count = 1
  30.          
  31.          Do While MyNumber <> ""
  32.                  If Count = 1 Then
  33.                 
  34.                    Temp = ConvertHundreds(Right(MyNumber, 3))
  35.                      
  36.                     If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
  37.                     If Len(MyNumber) > 3 Then
  38.                        ' Remove last 3 converted digits from MyNumber.
  39.                        MyNumber = Left(MyNumber, Len(MyNumber) - 3)
  40.                     Else
  41.                        MyNumber = ""
  42.                     End If
  43.                     Count = Count + 1
  44.                  Else
  45.                  ' Convert last 3 digits of MyNumber to English Rupees.
  46.                  If Len(MyNumber) = 1 Then
  47.                  Temp = ConvertDigit(MyNumber)
  48.                  Else
  49.                  Temp = ConvertTens(Right(MyNumber, 2))
  50.                  End If
  51.                     If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
  52.                     If Len(MyNumber) >= 3 Then
  53.                        ' Remove last 3 converted digits from MyNumber.
  54.                        MyNumber = Left(MyNumber, Len(MyNumber) - 2)
  55.                     Else
  56.                        MyNumber = ""
  57.                     End If
  58.                     Count = Count + 1
  59.                     End If
  60.          Loop
  61.          ' Clean up Rupees.
  62.          Select Case Rupees
  63.             Case ""
  64.                Rupees = ""
  65.             Case "One"
  66.                Rupees = "One Rupee"
  67.             Case Else
  68.                Rupees = Rupees & " Rupees"
  69.          End Select
  70.          ' Clean up Paise.
  71.          Select Case Paise
  72.             Case ""
  73.                Paise = ""
  74.             Case "One"
  75.                Paise = " And One Cent"
  76.             Case Else
  77.                Paise = " And " & Paise & " Paise"
  78.          End Select
  79.          ConvertCurrencyToEnglish = Rupees & Paise
  80. End Function
  81. Private Function ConvertHundreds(ByVal MyNumber)
  82. Dim Result As String
  83.          ' Exit if there is nothing to convert.
  84.          If Val(MyNumber) = 0 Then Exit Function
  85.          ' Append leading zeros to number.
  86.          MyNumber = Right("000" & MyNumber, 3)
  87.          ' Do we have a hundreds place digit to convert?
  88.          If Left(MyNumber, 1) <> "0" Then
  89.             Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
  90.          End If
  91.          ' Do we have a tens place digit to convert?
  92.          If Mid(MyNumber, 2, 1) <> "0" Then
  93.             Result = Result & ConvertTens(Mid(MyNumber, 2))
  94.          Else
  95.             ' If not, then convert the ones place digit.
  96.             Result = Result & ConvertDigit(Mid(MyNumber, 3))
  97.          End If
  98.          ConvertHundreds = Trim(Result)
  99. End Function
  100. Private Function ConvertTens(ByVal MyTens)
  101. Dim Result As String
  102.          ' Is value between 10 and 19?
  103.          If Val(Left(MyTens, 1)) = 1 Then
  104.             Select Case Val(MyTens)
  105.                Case 1: Result = "One"
  106.                Case 10: Result = "Ten"
  107.                Case 11: Result = "Eleven"
  108.                Case 12: Result = "Twelve"
  109.                Case 13: Result = "Thirteen"
  110.                Case 14: Result = "Fourteen"
  111.                Case 15: Result = "Fifteen"
  112.                Case 16: Result = "Sixteen"
  113.                Case 17: Result = "Seventeen"
  114.                Case 18: Result = "Eighteen"
  115.                Case 19: Result = "Nineteen"
  116.                Case Else
  117.             End Select
  118.          Else
  119.             ' .. otherwise it's between 20 and 99.
  120.             Select Case Val(Left(MyTens, 1))
  121.                Case 2: Result = "Twenty "
  122.                Case 3: Result = "Thirty "
  123.                Case 4: Result = "Forty "
  124.                Case 5: Result = "Fifty "
  125.                Case 6: Result = "Sixty "
  126.                Case 7: Result = "Seventy "
  127.                Case 8: Result = "Eighty "
  128.                Case 9: Result = "Ninety "
  129.                Case Else
  130.             End Select
  131.             ' Convert ones place digit.
  132.             Result = Result & ConvertDigit(Right(MyTens, 1))
  133.          End If
  134.          ConvertTens = Result
  135. End Function
  136. Private Function ConvertDigit(ByVal MyDigit)
  137. Select Case Val(MyDigit)
  138.             Case 1: ConvertDigit = "One"
  139.             Case 2: ConvertDigit = "Two"
  140.             Case 3: ConvertDigit = "Three"
  141.             Case 4: ConvertDigit = "Four"
  142.             Case 5: ConvertDigit = "Five"
  143.             Case 6: ConvertDigit = "Six"
  144.             Case 7: ConvertDigit = "Seven"
  145.             Case 8: ConvertDigit = "Eight"
  146.             Case 9: ConvertDigit = "Nine"
  147.             Case Else: ConvertDigit = ""
  148.          End Select
  149. End Function

Saturday, September 10, 2016

How to merge 2 or more MS word documents

How to merge 2 or more MS word documents. You can do this by manually copying the first file and pasting on to the second file. But if you have too many files to merge and if you have to do it repeatedly, its better to have automated setup.

Below macro will help you to merge 2 documents. You can edit the VBA code and add more files if you want. After merging, it will save as a new document. By default it will save the new merged file under My Documents. If you want the new files to be saved under a specific location, you can mention that the file name section

Sub Merge_2_files()

' Merge 2 files and save as a new document
NewFileName = "NewFile_" & Minute(Now) & "_" & Second(Now) & ".docx"

    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.InsertFile FileName:="C:\Users\inksanjeev\Desktop\A folder\Specifications.docx", Range:="", _
        ConfirmConversions:=False, Link:=False, Attachment:=False
    ActiveDocument.SaveAs2 FileName:=NewFileName, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
End Sub

Download the files
File 1

File 2

Thursday, August 4, 2016

How to get Unlimited Jio preview offer with Redmi Note 3

If you follow these steps carefully you will get the unlimited offer with Jio on your Redmi note 3.

Get the old apk of MyJio app from below link

Install MyJio and then all 11 applications from app store do not open any application

Turn off your data/wifi

Open MyJio app, then click on MyJio again.

You will see 3 options Get Jio SIM, Sign In and Sign Up.

Select Sign in

Enter you Jio ID and Password. You can generate your Jio ID by linking your Jio number with email ID on Jio.com.

Do not click on Sign In. Just enter the ID and Password.

Trun on the data/wifi

Click on Sign In.

You have to try couple of times to get to the next screen where it will ask you for submit. 

Once you get the submit button click that and that's all. Your unlimited offer is credited.

Enjoy unlimited Digital life for 3 months. Please your story on the comments below.

https://drive.google.com/open?id=0B4UB3eOhhY26eFdzVWViZU5EWGM