Exporting Data into WORD Table

[monster_redheaded]

I've got form data from an Access Database that needs to be exported
into word. Basically its a report where the user specifies the time
period they want to see for the data.

Im exporting it into a word table. No problem with that have it
working great. However, I want to Insert a TITLE and Time Period
above the table. But not into the header as people use the resulting
report to cut and paste into weekly/monthly reports. How do I do it?
My current code inserts it after the table.

Any suggestions would be greatlly appreciated.
THANX!
RHM


Heres the code I have working:

Private Sub cmdCreateCDRLReport_Click()

Dim aWordApp As Word.Application
Dim aRange As Word.Range, aTable As Word.Table
Dim aCell As Word.Cell
Dim iCol As Integer, iRow As Integer


'define recordset
Dim rst1 As DAO.Recordset
Set rst1 = Me.ss_Weekly_MAIN.Form.Recordset

'create word document
Set aWordApp = CreateObject("Word.Application")
aWordApp.Documents.Add

'insert title & date range current inserting AFTER the table

With aWordApp.ActiveDocument.Paragraphs(1).Range
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Bold = True
.Text = "CDRL Status" & vbCrLf & Me.TimePeriod
End With

'create table
Set aRange = aWordApp.ActiveDocument.Range(0, 0)

aWordApp.ActiveDocument.Tables.Add Range:=aRange,
NumRows:=rst1.RecordCount + 1, NumColumns:=8

'Make word visible
aWordApp.Visible = True

'format table and data
With aWordApp.ActiveDocument.Tables(1)
.AutoFormat wdTableFormatClassic2
.AutoFitBehavior wdAutoFitContent
'Paragraph alignment
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Font.Name = "Time New Roman"
.Range.Font.Size = 10
End With

'insert column titles
With aWordApp.ActiveDocument.Tables(1).Rows(1)
.Cells(1).Range.Text = "Project"
.Cells(2).Range.Text = "# CDRLs Submitted On-Time"
.Cells(3).Range.Text = "# CDRLs Submitted Late"
.Cells(4).Range.Text = "# CDRLs Approved"
.Cells(5).Range.Text = "# CDRLs Approved w/ Changes"
.Cells(6).Range.Text = "# CDRLs Closed"
.Cells(7).Range.Text = "# CDRLs Disapproved"
.Cells(8).Range.Text = "# CDRLs Awaiting Approval"

End With

'insert data
For iRow = 2 To rst1.RecordCount
iCol = 0
For Each aCell In
aWordApp.ActiveDocument.Tables(1).Rows(iRow).Cells
aCell.Range.Text = IIf(rst1.Fields(iCol) > 0,
rst1.Fields(iCol), "")
iCol = iCol + 1
Next aCell
rst1.MoveNext
Next iRow

'set up last row of table as a totals column
With aWordApp.ActiveDocument.Tables(1).Rows(rst1.RecordCount + 1)
.Cells(1).Range.Text = "TOTALS"
.Cells(2).Range.Text = Me.ss_Weekly_MAIN.Form.Early
.Cells(2).Range.Font.Bold = True
.Cells(3).Range.Text = Me.ss_Weekly_MAIN.Form.Late
.Cells(3).Range.Font.Bold = True
.Cells(4).Range.Text = Me.ss_Weekly_MAIN.Form.Approved
.Cells(4).Range.Font.Bold = True
.Cells(5).Range.Text = Me.ss_Weekly_MAIN.Form.ApprovedC
.Cells(5).Range.Font.Bold = True
.Cells(6).Range.Text = Me.ss_Weekly_MAIN.Form.Closed
.Cells(6).Range.Font.Bold = True
.Cells(7).Range.Text = Me.ss_Weekly_MAIN.Form.Disapproved
.Cells(7).Range.Font.Bold = True
.Cells(8).Range.Text = Me.ss_Weekly_MAIN.Form.Await
.Cells(8).Range.Font.Bold = True
End With

With aWordApp.ActiveDocument.Tables(1)
.AutoFitBehavior wdAutoFitFixed
End With

End Sub