从访问表中复制表并粘贴到空白Excel文件中 [英] Copy table from access table and paste into blank excel file

问题描述

我正在尝试将结果从访问表传输到将不保存的空白Excel文件中.基本上，我在访问表单上有一个按钮，当按下该按钮时，其动作将只是预览excel访问表中的所有记录.这是用户希望设置的方式.

I am trying to accomplish the transfer of results from an access table into a blank Excel file that is not going to be saved. Basically I have a button on an access form that when pressed its action is going to just preview all the records in the access table in excel. This is the way the user wants it set up.

现在我有可以打开一个空白excel文件的代码，但是我在编写将访问时复制该表并将其粘贴到excel中的代码时遇到了麻烦，例如单元格"A1"

Right now I have code that will open a blank excel file but I am having troubles writing code that will copy the table from access and paste it into excel, say Cell "A1"

Private Sub Command27_Click()
Dim dbs As DAO.Database
Dim Response As Integer
Dim strSQL As String
Dim Query1 As String
    Dim LTotal As String
    Dim Excel_App As Excel.Application 'Creates Blank Excel File
    Dim strTable As String ' Table in access


     strTable = "tbPrintCenter05Que" 'Access table I am trying to copy
     Set Excel_App = CreateObject("Excel.Application")
     Set dbs = CurrentDb

     Excel_App.Visible = True
     Excel_App.Workbooks.Add
With Excel_App
.Columns("A:ZZ").ColumnWidth = 25
.Copy ' Getting error on this line 
.Range ("A")
.Paste

推荐答案

这可能是一种方法

Private Sub Command27_Click()
    Dim dbs As dao.Database
    Dim Response As Integer
    Dim strSQL As String
    Dim Query1 As String

    Dim LTotal As String
    Dim Excel_App As Excel.Application 'Creates Blank Excel File
    Dim strTable As String ' Table in access


    strTable = "tbPrintCenter05Que" 'Access Query I am trying to copy
    Set Excel_App = CreateObject("Excel.Application")
    Set dbs = CurrentDb

    Dim rs As dao.Recordset
    Set rs = dbs.OpenRecordset(strTable)

    Excel_App.Visible = True

    Dim wkb As Excel.Workbook
    Set wkb = Excel_App.Workbooks.Add

    Dim rg As Excel.Range
    Dim i As Long
    ' Add the headings
    For i = 0 To rs.Fields.Count - 1
        wkb.Sheets(1).Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i

    Set rg = wkb.Sheets(1).Cells(2, 1)
    rg.CopyFromRecordset rs

    ' make pretty
    rg.CurrentRegion.EntireColumn.AutoFit

End Sub

这篇关于从访问表中复制表并粘贴到空白Excel文件中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！