如何把Access里的指定数据表经过筛选导出到指定格式的Excel表里

Question

如何把Access里的指定数据表经过筛选导出到指定格式的Excel表里。请举例，或写一段代码。如有兴趣可来信索取所需的数据库和Excel表格式。[email protected]
具体问题：数据表
        工程    材料1   材料2   材料3    材料4  
         1       2元     3元    3元      0元
         2        1       5       4       5
         3        12      0       6       3
 。
        excel格式 
        总计  元         
        工程   小计  材料1   材料2   材料3    材料4  
         1
         2
  。

Answer 1

    '存字段长度值
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    With Rs_Dzgl_Receipt
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Sub
        End If
        xlSheet.Cells(1, 4).Value = .Fields("bt")
        xlSheet.Cells(2, 1).Value = .Fields("invoice")
        xlSheet.Cells(2, 9).Value = .Fields("packdate")
        xlSheet.Cells(3, 1).Value = .Fields("")
                        
        '合并单元格
        Dim nIcol As Integer
        
        xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(5, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
            
        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
        '网格线
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Name = "黑体"
            '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True
            '标题字体加粗
            .Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
            '设表格边框样式
        End With
        
        '显示表格
        Dim ExclFileName As String
        ExclFileName = App.Path & "\箱单" & Text1(1).Text & ".xls"
        If Dir(ExclFileName) <> "" Then
            Kill ExclFileName
        End If
        xlSheet.SaveAs (ExclFileName)
        xlApp.Application.Visible = True
        '交还控制给Excel
        xlSheet.PrintPreview
       ' xlApp.Application.Quit
       ' xlApp.Quit
    End With

Answer 2

你可以将记录集导入excelhttp://www.csdn.net/develop/read_article.asp?id=14952或者将特定的数据写入excel的每个单元格

Answer 3

Dim cn as Adodb.Connection
Dim rs as Adodb.Recordset
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet数据库连接,查询Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)Dim iCurrentRow,iCurrentCol,i as integer
iCurrentRow =1:iCurrentCol =1 
For i = 0 to rs.Fields.Count - 1
  xlsheet.cells(iCurrentRow,iCurrentCol) = rs.Fields(i).Name
  iCurrentCol = iCurrentCol + 1
NextiCurrentRow = iCurrentRow+1:iCurrentCol =1
Do While Not rs.Eof
   For i = 0 to rs.Fields.Count - 1
     xlsheet.cells(iCurrentRow,iCurrentCol) = rs.Fields(i).Value
     iCurrentCol = iCurrentCol +1
   Next
   iCurrentRow = iCurrentRow+1:iCurrentCol =1
   rs.Movenext
LoopSet xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing