The below module works to create a tabled header on each page and a new page for each customer in my Access DB that this is being run from.
I've included the full code so you can see everything that's happening (Every sub gets called)
As it is, this code fills the tables properly. However, if I add anything at any point prior to the first time CreateHeader gets called, rows 2 and 3 of my tables are not filled.
Can anyone see where I'm going wrong here? I want to create a blank table on the first page, then the headers, then create a TableOfContents in the blank table.
Also, my Delimit function doesn't seem to be running at all. The intent is to use Heading 1 and Heading 2 to automatically build out a Table of Contents from headings.
Code:
Option Explicit
Public Function Test()
BuildCustomerDetailReport
End Function
Public Sub BuildCustomerDetailReport()
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Set wordApp = New Word.Application
Set wordDoc = wordApp.Documents.Add()
SetLayout wordDoc, wordApp
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim def As DAO.QueryDef
Set db = CurrentDb
Set def = db.QueryDefs![qryReport_CustomerDetails_PARAM]
def.Parameters![tier] = "Platinum"
Set rs = def.OpenRecordset
rs.MoveFirst
Delimit wordDoc, rs
Do Until rs.EOF
CreateHeader wordDoc, rs
rs.MoveNext
Loop
wordDoc.Tables.Add wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range, 1, 1
wordDoc.TablesOfContents.Add wordDoc.Tables(wordDoc.Tables.Count).Cell(1, 1).Range, True
wordApp.Visible = True
Set wordApp = Nothing
End Sub
Private Sub Delimit(wordDoc As Word.Document, rs As DAO.Recordset)
'this isn't even getting run somehow
wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.text = rs!strTier
wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.Style = wordDoc.Styles("Heading 1")
End Sub
Private Sub SetLayout(wordDoc As Word.Document, wordApp As Word.Application)
With wordDoc.Paragraphs.TabStops
.ClearAll
.Add Position:=InchesToPoints(0.75), Alignment:=wdAlignTabRight
.Add Position:=InchesToPoints(0.8), Alignment:=wdAlignTabLeft
.Add Position:=InchesToPoints(4.5), Alignment:=wdAlignTabRight
.Add Position:=InchesToPoints(4.55), Alignment:=wdAlignTabLeft
End With
wordDoc.Paragraphs.LineSpacingRule = wdLineSpaceExactly
wordDoc.Paragraphs.LineSpacing = 10
With wordDoc.PageSetup
.TopMargin = wordApp.InchesToPoints(0.2)
.BottomMargin = wordApp.InchesToPoints(0.5)
.LeftMargin = wordApp.InchesToPoints(0.5)
.RightMargin = wordApp.InchesToPoints(0.5)
End With
With wordDoc.Styles("Heading 2").Font
.Bold = True
.Size = 14
.name = "Calibri"
.Color = wdColorBlack
End With
With wordDoc.Styles("Heading 1").Font
.Bold = False
.Size = 11
.name = "Calibri"
.Color = wdColorBlack
End With
With wordDoc.Styles("Normal").Font
.Bold = False
.Size = 11
.name = "Calibri"
.Color = wdColorBlack
End With
End Sub
Private Sub CreateHeader(wordDoc As Word.Document, rs As DAO.Recordset)
Debug.Print wordDoc.Paragraphs.Count & " paragraphs, " & wordDoc.Tables.Count _
& " tables while populating " & rs!strCustName
wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.InsertBreak wdPageBreak
wordDoc.Tables.Add wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range, 3, 4
With wordDoc.Tables(wordDoc.Tables.Count)
.Columns(1).SetWidth InchesToPoints(1), wdAdjustNone
.Columns(2).SetWidth InchesToPoints(1), wdAdjustNone
.Columns(3).SetWidth InchesToPoints(2), wdAdjustNone
.Columns(4).SetWidth InchesToPoints(3), wdAdjustNone
.Rows(1).SetHeight 18, wdRowHeightAuto
.Rows(2).SetHeight 18, wdRowHeightExactly
.Rows(3).SetHeight 18, wdRowHeightExactly
With .Cell(1, 1)
.Merge wordDoc.Tables(wordDoc.Tables.Count).Cell(1, 2)
.Range.text = rs!strCustName
.Range.Style = wordDoc.Styles("Heading 2")
End With
With .Cell(2, 1)
.Range.text = "Tier:"
.Range.Paragraphs.Alignment = wdAlignParagraphRight
End With
With .Cell(2, 2)
.Range.text = rs!strTier
'.Range.ParagraphFormat.SpaceBefore = 0
End With
With .Cell(3, 1)
.Range.text = "Status"
.Range.Paragraphs.Alignment = wdAlignParagraphRight
End With
With .Cell(3, 2)
.Range.text = rs!strStatus
End With
With .Cell(1, 2)
.VerticalAlignment = wdCellAlignVerticalBottom
.Range.text = "Incident Notifications:"
.Range.Paragraphs.Alignment = wdAlignParagraphRight
End With
With .Cell(1, 3)
.VerticalAlignment = wdCellAlignVerticalBottom
.Range.text = SafeInsert(rs!strIncNotEmail)
End With
With .Cell(2, 3)
.Range.text = "Customer Surveys:"
.Range.Paragraphs.Alignment = wdAlignParagraphRight
End With
With .Cell(2, 4)
.Range.text = SafeInsert(rs!strCustSrvEmail)
End With
With .Cell(3, 3)
.Range.text = "Performance Summaries:"
.Range.Paragraphs.Alignment = wdAlignParagraphRight
End With
With .Cell(3, 4)
.Range.text = SafeInsert(rs!strPerfSumEmail)
End With
End With
wordDoc.Paragraphs(wordDoc.Paragraphs.Count).Range.InlineShapes.AddHorizontalLineStandard
Debug.Print wordDoc.Paragraphs.Count & " paragraphs, " & wordDoc.Tables.Count
End Sub