How to create a formatted Word report from a spreadsheet with multiple Excel rows / columns

Question

I am trying to automatically create a formatted Word report from an Excel template used by several commands. For example, if I have the following Excel structure:

...... A .... | ..... B .... | .... C ...
1 Name | Height | Weight
2 Jason | 74 | 170
3 Greg | 70 | 160
4 Sam | 71 | 200

and I want to pull this data and format it into a Word file with the following format:

2.1 Jason
Growth: 74
Weighing: 170

2.2 Greg
Growth: 70
Weight: 160

2.3 Sam
Growth: 71
Weight: 200

Is there a quick way to do this using VBA and be able to iterate over as many rows as can exist in any particular Excel file? (may vary from several to several hundred). The actual excel file contains about a dozen columns, where for each record (line) the data needs to be pulled out and formatted using a standard template (font size / color, indentation, alignment, etc.) ...), but I would just like to extract extract to work, and I can play with formatting later.

For reference, I tried to investigate well-known solutions, but most of them are focused on named bookmarks and relatively static content, as well as on interaction through a dynamic number of lines and analysis of the same data for each.

Answer 1

If you end up using VBA, you can use the code below, starting with a dictionary document. Verify that the link to the Microsoft Excel XX object library is listed under Tools> Links in VBE.

Just so you know, the part in which it puts lines in Word can probably be written better. Word is my weakest of all MS Office products in terms of knowledge.

Sub XLtoWord() Dim xlApp As Excel.Application 'Set xlApp = CreateObject("Excel.Application") Set xlApp = GetObject(, "Excel.Application") '-> assumes XL is open, if not use CreateObject Dim wkb As Excel.Workbook Set wkb = xlApp.Workbooks("Book5.xlsm") '-> assumes xl is open, if not use .Workbooks.Open(filename) Dim wks As Excel.Worksheet Set wks = wkb.Sheets(1) '-> assumes data is in sheet 1 With wks Dim lngRow As Long lngRow = .Range("A" & .Rows.Count).End(xlUp).Row Dim cel As Excel.Range Dim i As Integer i = 1 For Each cel In .Range("A2:A" & lngRow) 'assumes data is filled from top left cell of A1 including headers strLabel = "2." & i & " " & cel.Text strHeight = "Height " & cel.Offset(, 1).Text strWeight = "Weight " & cel.Offset(, 2).Text Dim myDoc As Word.Document Set myDoc = ThisDocument myDoc.Range.InsertParagraphAfter myDoc.Range.InsertAfter strLabel & Chr(11) & strHeight & Chr(11) & strWeight i = i + 1 Next End With End Sub