前端之家

  1. 首页
  2. 问答

从访问表中复制表并粘贴到空白Excel文件中

• 问答

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

现在我有打开一个空白excel文件的代码，但是我在编写将访问时复制该表并将其粘贴到excel中的代码时遇到了麻烦，例如单元格“ 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
liyazhao 回答：从访问表中复制表并粘贴到空白Excel文件中

这可能是一种方式

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
excelms-accessvba
本文链接：https://www.f2er.com/3151456.html

大家都在问