<form id="hbx9t"></form>

<noframes id="hbx9t">

    <em id="hbx9t"><span id="hbx9t"></span></em>

        <noframes id="hbx9t"><address id="hbx9t"><th id="hbx9t"><progress id="hbx9t"></progress></th></address>
        office交流網--QQ交流群號

        Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

        Word交流群:218156588             PPT交流群:324131555

        access導出數據表內容到word文檔中

        2020-12-23 08:00:00
        tmtony8
        原創
        5828

        access是office的組件,既然是同一個母親,那么和Excel,word之間的交互顯然是非常方便的。

        我們有時要把access的數據導出到Excel表格,也會把access數據導出到word中。

        如下,把access中人員信息表的人員信息導入到word中,并生成表格:


        On Error GoTo Err_Add
            Dim WdApp As Word.Application
            Dim WdDoc As Word.Document
            Dim StrAdr As String
            Dim Db As DAO.Database
            Dim rs As DAO.Recordset
            Set Db = CurrentDb
            Set rs = Db.OpenRecordset("員工信息")    
            StrAdr = CurrentProject.Path & "\示例1.docx"
            Set WdApp = GetObject(, "Word.Application")
            Set WdDoc = WdApp.Documents.Open(StrAdr)
            WdApp.Visible = True
            '在word中創建一個兩列的表格,并添加邊框
            WdDoc.Tables.Add Selection.Range, 1, 2
            For Each atable In WdDoc.Tables
                atable.Borders.OutsideLineStyle = wdLineStyleSingle
                atable.Borders.InsideLineStyle = wdLineStyleSingle
            Next atable
            '將Access數據表中的數據添加到創建的word表格中
            Set Db = CurrentDb
            Set rs = Db.OpenRecordset("員工信息")
            With WdApp.Selection
                    .TypeText "姓名"    '添加表頭
                    .MoveRight wdCell    '向右移動
                    .TypeText "性別"
                    .MoveRight wdCell
                    Do While rs.EOF = False
                        .TypeText rs![姓名]
                        .MoveRight wdCell
                        .TypeText rs![性別]
                        .MoveRight wdCell
                        rs.MoveNext
                    Loop
            End With    
            WdApp.Selection.Rows.Delete  '刪除最后的空行
         
        Err_Add:
            If Err = 429 Then
                Set WdApp = CreateObject("Word.Application")
                Resume Next
            End If
            WdDoc.Save
        End Sub


          分享