Microsoft Access 2007 VBA 產生 Word 文件排版

Reference:
http://access911.net/fixhtm/78FAB71E15DC_big5.htm
http://msdn.microsoft.com/en-us/library/office/ff845710.aspx
http://msdn.microsoft.com/en-us/library/office/ff845882.aspx

需求：
以Access資料製作Word文件並自動排版。使用者可對Word文件做微調以符合實際需求。

範例：
查詢資料表dbo_IDLI45，列出欄位TG001, TG002的內容。並可用TG001當作查詢條件。
查詢結果放到Word表格，並將表格置中、自動調整表格列寬、畫格線

做法：
1. 建立表單，增加文字方塊、按鈕

2. 調整按鈕的屬性，On-Click改為事件程序

3. 在VB編輯器增加引用項目 Microsoft ActiveX Data Objects 2.1 Library, Microsoft Word 12.0Object Library

4. 輸入程式碼如下：
Private Sub Command8_Click()
    '建立資料連線
    Set cnn = New ADODB.Connection
    Set cnn = CurrentProject.Connection

    '以文字方塊的內容製作查詢條件
    Set rs = New ADODB.Recordset
    SQL = "select TG001, TG002 from dbo_IDLI45 where TG001 = '" & TG001.Value & "'"
 
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
 
    total_fields = rs.Fields.Count
    total_records = rs.RecordCount

    '用範本檔Doc1.dotx產生Word文件
    Set mywdapp = CreateObject("word.application")
    mywdapp.Documents.Add Template:=CurrentProject.Path & "\Doc1.dotx"
 
    mywdapp.Visible = True
    mywdapp.Activate

    '在Word文件輸出一行文字
    mywdapp.Selection.TypeText Text:="IDLI45" & vbCrLf

    '選擇目前的游標點當作範圍
    Set myRange = mywdapp.Selection.Range
    '產生表格
    Set tblNew = mywdapp.ActiveDocument.Tables.Add(Range:=myRange, NumRows:=total_records, NumColumns:=total_fields)
 
    rs.MoveFirst

    '在表格中填入查詢結果
    With tblNew
     For intX = 1 To total_records
        For intY = 1 To total_fields
        .Cell(intX, intY).Range.InsertAfter rs.Fields(intY - 1).Value
        Next intY
        rs.MoveNext
     Next intX
     .Columns.AutoFit
    End With
 
    rs.Close
    Set rs = Nothing

    '表格置中、自動調整表格列寬
    tblNew.Rows.Alignment = wdAlignRowCenter
    tblNew.AutoFitBehavior wdAutoFitContent

    '畫格線
    With tblNew
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderHorizontal)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = wdColorAutomatic
        End With
        .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
        .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With

    '將由標移到文件最前面
    mywdapp.Selection.HomeKey Unit:=wdStory
End Sub

2013/7/26 update:
    '將游標下移一行
    mywdapp.Selection.MoveDown Count:=1
    '將游標右移一個
    mywdapp.Selection.MoveRight Count:=1

    'TA003="20130717"，先用format改為日期格式，再轉為 Jul 17. 2013
    iDate = CDate(Format(TA003, "0000-00-00"))
    mywdapp.Selection.TypeText Text:=Format(iDate, "mmm d. yyyy")

    '將游標移到table 2第一格

    mywdapp.ActiveDocument.Tables(2).Cell(1, 1).Select

    '在table 2第三行 "上面" 增加一行

    mywdapp.ActiveDocument.Tables(3).Rows.Add BeforeRow:=tblNew.Rows(3)

    '在table 2第二行 "下面" 增加一行 (相當於先移到第二行最後一格，再將游標往右移，按Enter)

    mywdapp.ActiveDocument.Tables(3).Cell(2, 7).Select

    mywdapp.Selection.MoveRight Count:=1

    mywdapp.Selection.InsertRows 1

    '檢查文字方塊是否有資料 (reference: http://stackoverflow.com/questions/3751233/access-vba-if-form-value-null-then-run-query-else-end-if-not-doing-anyth)
    If (Nz(TG001.Value, "") = "") Then
        MsgBox "請輸入TG001"
        Exit Sub
    End If