VBA Macro to copy Excel data into MS Word table

The below code will help you to copy the MS Excel data into MS Word. The main thing to note here is, the Excel data is copied into Word in a table format. This is a very basic VBA code, you can extend this to add other features.

To add this code to your excel, Open VBA editor in Excel or you can press F11. Insert a module, paste this code. Come back to excel by pressing F11 again. Under macros you can see the name of subroutine 'CopyFromExcelToWord' appearing, this is your macro.

Sub CopyFromExcelToWord()
   Dim objWord
   Dim objDoc
   Dim objRange
   Dim total_rows
   Dim total_cols
   Dim objTable
   Dim tmp_row
   Dim tmp_col
    total_rows = Cells(1, 10).Value
    total_cols = Cells(2, 10).Value
    Set objWord = CreateObject("Word.Application")

  Set objDoc = objWord.Documents.Add
  Set objRange = objDoc.Range
  objWord.Visible = True

  objDoc.Tables.Add objRange, total_rows, total_cols
  'objWord.SaveAs ("C:\Users\sanjeeva\Documents\krishna\personal\videos\a.docm")
  Set objTable = objDoc.Tables(1)
    objTable.Borders.Enable = True
  For tmp_row = 1 To total_rows
     For tmp_col = 1 To total_cols
        objTable.Cell(tmp_row, tmp_col).Range.Text = Cells(tmp_row, tmp_col)
     Next
  Next
End Sub

How to create MS Word document automatically with Text file

This VBA code will help you to import data from a text file and insert it into the MS word document. This is useful when you have to create a report or formats in MS Word format, reading the data from a text file. The VBA code can be extended import extra data from the text file, and also you can add additional format as per your needs.

Please note that VBA macros can cause harm to your computer. First, open them in a disabled mode. To disable macros, to Developer tab, select macro security and then select Macro settings on the left side pane. In the right pane, select the second radio button, 'Disable all macros with notification'. The second option is better because it will notify you if there are any macros associated with your file. So you will not miss any document features that may be available after running a macro. But you can decide whether to allow the macros to run or not.

Please click on the below link to download the MS Word Template file. You can also download the text file used to import the data. I remind you that this is a sample file. You may have to modify the VBA code according to your requirement. You may have to rename the input file.

Please leave a comment below if you have any concerns.
MS word template

The VBA Code
-------------------
Sub Document_Open()
If (ActiveDocument.Name = "Template.docm") Then
With ActiveDocument
 
   On Error Resume Next
    .Variables.Add Name:="1", Value:="1"
    .Variables.Add Name:="2", Value:="2"
    .Variables.Add Name:="3", Value:="3"
    .Variables.Add Name:="4", Value:="4"
    .Variables.Add Name:="5", Value:="5"
    .Variables.Add Name:="6", Value:="6"
   
    Dim ReadData As String
    Dim myarray() As String
   
    Open ActiveDocument.Path & "\text.txt" For Input As #1

    Do Until EOF(1)
       Line Input #1, ReadData
    If Not Left(ReadData, 1) = "*" Then
    myarray = Split(ReadData, ",")
    End If

    Loop

    Close #1

    i = 1
    For Each f In myarray
       .Variables(i).Value = f
       i = i + 1
    Next f
    .Fields.Update
End With

With ActiveDocument
strFileName = "Agreement Between " & myarray(5) & " and " & myarray(0)
strPath = .Path

.SaveAs2 (strPath & "\" & strFileName)
'.Close SaveChanges:=wdDoNotSaveChanges
Application.Quit SaveChanges:=wdDoNotSaveChanges
'.Application.
End With
End If
End Sub
-------------------

MS Excel Currency converter VBA code

To convert numbers into text, there is no builtin function in MS Excel as of now. Using the below VBA code you can overcome this issue. There are situations like writing a cheque leaf, printing a rent agreement, or writing contract documents that may require printing the transaction amount in the text. Make use of this code to convert numbers into text automatically. 

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