Export Data to MS Word Table and Format

[j.t.w]

Hello Everyone,

I've gathered code from other posts and have come up with output to a
Word document that is acceptable (thanks to everyone for sharing).

I would like know if it is possible to format the table in MS Word.
1) Left justifying the 1st column, and centering the data in columns 2
to 4.
2) Is there a better way of handling the column widths to
automatically size to the widest data in the column.
3) Any good resources to help export data to MS Word.

Here's what I have so far...

Sub Export_Word()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Set oWord = New Word.Application
Set oDoc = New Word.Document

Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("My_Crosstab_query")

With oDoc.ActiveWindow.Document.PageSetup
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
End With

oDoc.ActiveWindow.Selection.TypeText Text:="Summary:" & vbCrLf &
vbCrLf
oDoc.ActiveWindow.Selection.Tables.Add
Range:=oDoc.ActiveWindow.Selection.Range, numrows:=1, numcolumns:=4
oDoc.ActiveWindow.Selection.Tables(1).Style = "Table Grid"

'Create Table Headers
oDoc.Tables(1).Columns(1).Cells(1).Range.Text = ""
'rs.Fields(0).Name
oDoc.Tables(1).Columns(2).Cells(1).Range.Text = "FY " &
rs.Fields(1).Name
oDoc.Tables(1).Columns(3).Cells(1).Range.Text = "FY " &
rs.Fields(2).Name
oDoc.Tables(1).Columns(4).Cells(1).Range.Text = "FY " &
rs.Fields(3).Name
'Format Table Headers
oDoc.Tables(1).Columns(1).Width = 200
oDoc.Tables(1).Columns(2).Width = 75
oDoc.Tables(1).Columns(3).Width = 75
oDoc.Tables(1).Columns(4).Width = 75

'Export Data to Cells
i = 1
Do Until rs.EOF
oDoc.Tables(1).Columns(1).Cells.Add
oDoc.Tables(1).Columns(1).Cells(i + 1).Range.Text =
rs.Fields(0)
oDoc.Tables(1).Columns(2).Cells(i + 1).Range.Text =
Format(rs.Fields(1), "#,###.00")
oDoc.Tables(1).Columns(3).Cells(i + 1).Range.Text =
Format(rs.Fields(2), "#,###.00")
oDoc.Tables(1).Columns(4).Cells(i + 1).Range.Text =
Format(rs.Fields(3), "#,###.00")
i = i + 1
rs.MoveNext
Loop

'Format Table Headers
oDoc.Tables(1).Rows(1).Range.Font.Bold = True
oDoc.Tables(1).Range.ParagraphFormat.Alignment = 1 'Center

oDoc.ActiveWindow.Document.SaveAs ("Export.doc")

oDoc.ActiveWindow.Document.Close True
oWord.Quit True
Set oDoc = Nothing
Set oWord = Nothing
End Sub

Thanks in advance for any and all help.

j.t.w

 

[PieterLinden via AccessMonster.com]

You can loop over the columns/cells in the Word document and modify the
alignment.
'Private Sub WriteWord(ByVal strDoc As String, ByVal lngRow As Long, _
' ByVal lngColumn As Long, ByVal varWriteSomething)
'
'' Author: Doug Robbins, Word MVP
'' Date: 2/21/2009
'
' Dim appWord As Word.Application
' Dim docWord As Word.Document
' Dim docRange As Word.Range
' Set appWord = New Word.Application
' Set docWord = appWord.Documents.Open(strDoc)
' Dim dRange As Range, aCell As Cell, aPara As Paragraph
'
' With docWord.Tables(1).Cell(lngRow, lngColumn)
' .Range.Text = varWriteSomething
' Set docRange = .Range
' With docRange
' .End = .End - 1
' .ConvertToTable
' Set dRange = .Tables(1).Cell(1, 1).Range
' dRange.End = dRange.End - 1
' If IsNumeric(dRange.Text) Then
' For Each aCell In dRange.Tables(1).Range.Cells
' For Each aPara In aCell.Range.Paragraphs
' aPara.Alignment = wdAlignParagraphRight
' Next
' Next
' End If
' End With
' End With
'
' docWord.Close True
' Set docWord = Nothing
' appWord.Quit
' Set appWord = Nothing
'
' lngRow = fatest
'End Sub