Exporting Data into WORD Table

[RedHeadedMonster]

I've got form data from and 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?

Thanx for any assistance!
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 CURRENTLY THIS IS BEING INSERTED 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

 

[Doug Robbins - Word MVP]

I think I answered this somewhere else. Yes, it was in the vba.general
newsgroup yesterday.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP