Office中国论坛/Access中国论坛

标题: 请教！如何将不同的表导出到同一个Excel中？ [打印本页]
作者: sxgaobo    时间: 2016-10-22 17:02
标题: 请教！如何将不同的表导出到同一个Excel中？
请教各位大侠！如何用代码将不同的表导出到同一个Excel的不同的工作表中？
作者: tmtony    时间: 2016-10-22 17:05
控制 Excel.Application
然后 用Worksheets.add 添加一个新的工作表 然后把内容写进去
大致可能是这样的原理
作者: Henry D. Sy    时间: 2016-10-22 17:20
方法很多，不知道哪种适合你，
最好传上例子
作者: sxgaobo    时间: 2016-10-22 17:42
Henry D. Sy 发表于 2016-10-22 17:20
方法很多，不知道哪种适合你，
最好传上例子

    DoCmd.OutputTo acTable, "表1", "MicrosoftExcelBiff8(*.xls)", "D:\123\导出数据.xls", False, "", 0
    DoCmd.OutputTo acTable, "表2", "MicrosoftExcelBiff8(*.xls)", "D:\123\导出数据.xls", False, "", 0
这个一运行就提示是否覆盖已有的  导出数据.xls  
作者: Henry D. Sy    时间: 2016-10-22 18:01
sxgaobo 发表于 2016-10-22 17:42
DoCmd.OutputTo acTable, "表1", "MicrosoftExcelBiff8(*.xls)", "D:\123\导出数据.xls", False, "", ...

这个是最简单的导出
而且会覆盖同文件名的
作者: sxgaobo    时间: 2016-10-22 18:56
tmtony 发表于 2016-10-22 17:05
控制 Excel.Application
然后 用Worksheets.add 添加一个新的工作表 然后把内容写进去
大致可能是这样的 ...

能麻烦您给做个例子吗？
作者: Henry D. Sy    时间: 2016-10-25 17:11
sxgaobo 发表于 2016-10-22 18:56
能麻烦您给做个例子吗？
  1. Private Sub Command0_Click()

  3.     Dim rs As New ADODB.Recordset
  4.     Dim rst As New ADODB.Recordset
  5.     Dim sSQL As String
  6.     Dim xlApp As New Excel.Application
  7.     Dim xlBook As Workbook
  8.     Dim xlSheet As Worksheet
  9.     Dim i As Integer

  11.     On Error GoTo Command0_Click_Error

  13.     Set xlApp = CreateObject("Excel.Application")
  14.     Set xlBook = Nothing
  15.     Set xlSheet = Nothing
  16.     Set xlBook = xlApp.Workbooks().Add
  17.     xlBook.SaveAs CurrentProject.Path & "" & Format(Now(), "yyyy mmdd hhmm") & " UNION.xlsx"
  18.     sSQL = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type)=1) AND ((Left([name],4))<>'msys')) ORDER BY MSysObjects.Name DESC"
  19.     rs.Open sSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  20.     Do While Not rs.EOF
  21.         Set xlSheet = xlBook.Worksheets.Add
  22.         xlSheet.Name = rs.Fields(0)
  23.         rst.Open xlSheet.Name, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  24.         For i = 0 To rst.Fields.Count - 1
  25.             xlSheet.Cells(1, i + 1) = rst.Fields(i).Name
  26.         Next
  27.         xlSheet.Range("A2").CopyFromRecordset rst
  28.         rst.Close
  29.         rs.MoveNext
  30.     Loop
  31.     rs.Close
  32.     Set rst = Nothing
  33.     Set rs = Nothing
  34.     xlBook.Save
  35.     xlApp.WindowState = xlMaximized
  36.     xlApp.Application.Visible = True
  37.     Set xlSheet = Nothing
  38.     Set xlBook = Nothing
  39.     Set xlApp = Nothing

  41.     On Error GoTo 0
  42.     Exit Sub

  44. Command0_Click_Error:

  46.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
  47. End Sub
复制代码
[attach]60164[/attach]


作者: Henry D. Sy    时间: 2016-10-25 17:22
忘记说要引用
[attach]60165[/attach]
作者: sxgaobo    时间: 2016-10-25 20:01
Henry D. Sy 发表于 2016-10-25 17:22
忘记说要引用

谢谢！辛苦了~~~！！！



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3