VBA: Generating Word files from Excel data

Beatnik on 2008-03-18T19:49:51

I had data in an Excel file that I wanted to get into Word in a very nice layout, with some fancy introduction text. I came up with the following VBA code:

Public Sub GenDoc()
 Dim WordDocument As Word.Document
 Dim TableTemplate As Word.Document
 Dim DocumentTemplate As Word.Document
 Dim WordApplication As Word.Application
 Dim DocumentRange As Word.Range
 Dim ExcelWorksheet As Excel.Worksheet

 Dim i As Integer
 Set WordApplication = CreateObject("Word.Application")

 ' Template for fancy introduction
 ' Open as read-only
 Set DocumentTemplate = WordApplication.Documents.Open("template1.doc", False, True)

 ' Template for fancy layout per Excel row 
 ' Open as read-only
 Set TableTemplate = WordApplication.Documents.Open("template2.doc", False, True)

 WordApplication.Visible = False
 Set WordDocument = WordApplication.Documents.Add
 Set DocumentRange = WordDocument.Content

 ' This bit apparently guarantees that pasted blocks are appended, not overwriting the selected block
 DocumentRange.Collapse Direction:=wdCollapseEnd
 DocumentTemplate.Content.Copy
 ' Paste the fancy header into the newly created document
 DocumentRange.Paste
 Set ExcelWorksheet = ThisWorkbook.Worksheets.Item(1)
 ' Assume 100 columns
 For i = 1 To 100
  DocumentRange.Collapse Direction:=wdCollapseEnd
  ' Paste the formatted table stuff
  TableTemplate.Content.Copy
  DocumentRange.Paste    

  ' In the fancy template, I had some markers..
  ' Replace counter - NUMBERMARKER
  WordDocument.ActiveWindow.Selection.Find.ClearFormatting
  WordDocument.ActiveWindow.Selection.Find.Replacement.ClearFormatting
  With WordDocument.ActiveWindow.Selection.Find
   .Text = "NUMBERMARKER"
   ' Replace NUMBERMARKER with i
   .Replacement.Text = i
   .Wrap = wdFindStop
   .Format = False
   .MatchWholeWord = True
   .MatchSoundsLike = False
   .MatchAllWordForms = False
  End With
  WordDocument.ActiveWindow.Selection.Find.Execute Replace:=wdReplaceAll
 Next i

 ' Wrap it up
 DocumentTemplate.Close
 TableTemplate.Close
 WordApplication.Visible = True
 WordApplication.Activate
End Sub

I also had some fancy progress bar in there somewhere.. I'm getting quite good at this drive-by VBA coding.