关于Access数据在datagrid界面上导出查询结果到excel里，可在excel里排版打印的问题

  *************关于Access数据在datagrid界面上导出查询结果到excel里，可在excel里排版打印的问题****************
   本人一个软件所使用数据库是ACCESS，下面的两段代码是我的两个窗体的代码，我想在窗体Frm_find里加一个按钮，可以实现把查询结果显示在datagrid里数据导出到EXCEL里进行排版编辑等。其实这个按钮是存在的了，就是Command3，不过它只能把整个数据库里的一个表内容都打导出来了，不能实现只导出查询内容。，
    还有一个问题是：由于FrmSql窗体只是实现查询并返回的一个功能界面，能否把FrmSql窗体的查询功能界面合并在Frm_find窗体界面上一起显示？我试过了，但是老是调试不成功，接收有问题。
   不知有没有办法可以解决这两个问题呢，高手帮个忙不？给点提示或是改个代码什么的，呵，先谢了。

==============以下是Frm_find窗体代码===============================================
Private adoPrimaryRS  As ADODB.Recordset
Private blnIsSQL As Boolean
Private Sub Command1_Click()

            FrmSql.sqlado = "wzzl_v"
            FrmSql.intNumField = 9
            FrmSql.Show vbModal
            Select Case FrmSql.intNumField
                Case -1, -2
                    blnIsSQL = False

                     If Not (adoPrimaryRS.EOF And adoPrimaryRS.BOF) Then
                     i = adoPrimaryRS.Bookmark
                     adoPrimaryRS.Filter = ""
                     adoPrimaryRS.Requery
                     format_table
                     adoPrimaryRS.Bookmark = i
                     Else
                     adoPrimaryRS.Filter = ""
                     adoPrimaryRS.Requery
                     format_table
                    End If

                    'adoPrimaryRS.Filter = Me.DataGrid1.Columns.Item(0).DataField & "<>''"

                Case Else
                    blnIsSQL = True
                    adoPrimaryRS.Filter = Me.DataGrid1.Columns.Item(FrmSql.intNumField).DataField & FrmSql.strSqlField
            End Select
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
Dim conn As Connection
Dim rs As Recordset
Dim strcon As String
Dim sql As String
Dim xlapp As excel.Application
Dim xlsheet As excel.Worksheet
Dim xlbllk As excel.Workbook
Dim d1 As String
Dim d2 As String
Dim d3 As String
Dim d4 As String
Dim d5 As String
Dim d6 As String
Dim d7 As String
Dim d8 As String
Dim d9 As String

Set conn = New ADODB.Connection
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("ziliao.lbl")
conn.Open strcon
Set rs = New ADODB.Recordset
sql = "select 编号,文件名称,数量,类型,入库时间,编制单位,编制时间,存放位置,备注 from wzzl_v"
rs.Open sql, conn, adOpenDynamic, adLockOptimistic
Set xlapp = New excel.Application
Set xlapp = CreateObject("excel.application")
xlapp.Visible = True
Set xlbllk = xlapp.Workbooks.Add
Set xlsheet = xlbllk.Worksheets(1)

xlsheet.Rows(1).Font.Size = 18
xlsheet.Range("A1:I1").MergeCells = True
xlsheet.Range("A1:I1") = "全部《文件资料》列表"

xlsheet.Range("A1:I2").HorizontalAlignment = xlCenter '居中问题
xlsheet.Range("A1:I2").VerticalAlignment = xlCenter
xlsheet.Range("A1:I2").Font.Bold = True

xlsheet.Columns("A").HorizontalAlignment = xlCenter
xlsheet.Columns("A").VerticalAlignment = xlCenter

xlsheet.Columns("C").HorizontalAlignment = xlCenter
xlsheet.Columns("C").VerticalAlignment = xlCenter

xlsheet.Columns("E").HorizontalAlignment = xlCenter
xlsheet.Columns("E").VerticalAlignment = xlCenter

xlsheet.Columns("F").HorizontalAlignment = xlCenter
xlsheet.Columns("F").VerticalAlignment = xlCenter

xlsheet.Columns("G").HorizontalAlignment = xlCenter
xlsheet.Columns("G").VerticalAlignment = xlCenter

xlsheet.Columns("H").HorizontalAlignment = xlCenter
xlsheet.Columns("H").VerticalAlignment = xlCenter

xlsheet.Columns("I").HorizontalAlignment = xlCenter
xlsheet.Columns("I").VerticalAlignment = xlCenter

If IsNull(rs!编号) = False Then
   xlsheet.Cells(2, 1) = "编号"

End If
If IsNull(rs!文件名称) = False Then
   xlsheet.Cells(2, 2) = "文件名称"
End If
If IsNull(rs!数量) = False Then
   xlsheet.Cells(2, 3) = "数量"
End If
If IsNull(rs!类型) = False Then
   xlsheet.Cells(2, 4) = "类型"
End If
If IsNull(rs!入库时间) = False Then
   xlsheet.Cells(2, 5) = "入库时间"
End If
If IsNull(rs!编制单位) = False Then
   xlsheet.Cells(2, 6) = "编制单位"
End If
If IsNull(rs!编制时间) = False Then
   xlsheet.Cells(2, 7) = "编制时间"
End If
If IsNull(rs!存放位置) = False Then
   xlsheet.Cells(2, 8) = "存放位置"
End If

   xlsheet.Cells(2, 9) = "备注"

i = 3
Do While Not rs.EOF
d1 = rs.Fields("编号") & ""
d2 = rs.Fields("文件名称") & ""
d3 = rs.Fields("数量") & ""
d4 = rs.Fields("类型") & ""
d5 = rs.Fields("入库时间") & ""
d6 = rs.Fields("编制单位") & ""
d7 = rs.Fields("编制时间") & ""
d8 = rs.Fields("存放位置") & ""
d9 = rs.Fields("备注") & ""
xlsheet.Cells(i, 1) = d1
xlsheet.Cells(i, 2) = d2
xlsheet.Cells(i, 3) = d3
xlsheet.Cells(i, 4) = d4
xlsheet.Cells(i, 5) = d5
xlsheet.Cells(i, 6) = d6
xlsheet.Cells(i, 7) = d7
xlsheet.Cells(i, 8) = d8
xlsheet.Cells(i, 9) = d9

i = i + 1
rs.MoveNext
Loop
End Sub

Private Sub Command4_Click()
On Error GoTo Err23:


  Dim db As ADODB.Connection
  Set db = New ADODB.Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("ziliao.lbl")

  Set adoPrimaryRS = New Recordset

  adoPrimaryRS.Open "select 自动,编号,文件名称,数量,类型,入库时间,编制单位,编制时间,存放位置,已借,备注 from wzzl_v order by 编号,自动 desc", db, adOpenStatic, adLockOptimistic


  Set DataGrid1.DataSource = adoPrimaryRS
  format_table


Exit Sub
Err23:
    MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub Command5_Click()
Call Form_Load
End Sub

Private Sub Form_Load()
On Error GoTo Err23:


  Dim db As ADODB.Connection
  Set db = New ADODB.Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("ziliao.lbl")

  Set adoPrimaryRS = New Recordset

  adoPrimaryRS.Open "select 自动,编号,文件名称,数量,类型,入库时间,编制单位,编制时间,存放位置,已借,备注 from wzzl_v order by 自动 desc", db, adOpenStatic, adLockOptimistic


  Set DataGrid1.DataSource = adoPrimaryRS
  format_table


Exit Sub
Err23:
    MsgBox Err.Description, vbCritical, "错误"
End Sub
Private Sub format_table()
DataGrid1.Columns(0).Width = 0
DataGrid1.Columns(1).Width = 1200
DataGrid1.Columns(2).Width = 3500
DataGrid1.Columns(3).Width = 480
DataGrid1.Columns(4).Width = 2600
DataGrid1.Columns(5).Width = 1000
DataGrid1.Columns(6).Width = 1400
DataGrid1.Columns(7).Width = 850
DataGrid1.Columns(8).Width = 900
DataGrid1.Columns(9).Width = 480
DataGrid1.Columns(10).Width = 1500

DataGrid1.Columns(0).Caption = "自动"
DataGrid1.Columns(1).Caption = "编号"
DataGrid1.Columns(2).Caption = "            文件名称"
DataGrid1.Columns(3).Caption = "数量"
DataGrid1.Columns(4).Caption = "          类    型"
DataGrid1.Columns(5).Caption = "入库时间"
DataGrid1.Columns(6).Caption = "  编制单位"
DataGrid1.Columns(7).Caption = "编制时间"
DataGrid1.Columns(8).Caption = "存放位置"
DataGrid1.Columns(9).Caption = "已借"
DataGrid1.Columns(10).Caption = "备注"

For i = 0 To 10
   DataGrid1.Columns(i).Alignment = dbgCenter
Next i
   DataGrid1.Columns(2).Alignment = dbgLeft
DataGrid1.AllowRowSizing = False
DataGrid1.AllowUpdate = False
End Sub
=============================================================== --------------------编程问答-------------------- 接上面：

=================以下是FrmSql窗体代码=======================
Public intNumField As Integer
Public strSqlField As String
Public sqlado As String
Dim a(30) As Integer

Private Sub CboField_Click()
  If a(CboField.ListIndex) <> 7 Then
      TxtSQL.Locked = False
      DTPicker1.Enabled = False
  Else
      TxtSQL.Locked = True
      DTPicker1.Enabled = True
      TxtSQL.Text = DTPicker1.Value
  End If
  Select Case a(CboField.ListIndex)
  Case 2, 3, 6, 7
    Combo1.Clear
    Combo1.AddItem "= ", 0
    Combo1.AddItem "> ", 1
    Combo1.AddItem ">= ", 2
    Combo1.AddItem "< ", 3
    Combo1.AddItem "<= ", 4
    Combo1.AddItem "<> ", 5
    Combo1.ListIndex = 0
  Case Else
    Combo1.Clear
    Combo1.AddItem "包含", 0
    Combo1.AddItem "> ", 1
    Combo1.AddItem ">= ", 2
    Combo1.AddItem "< ", 3
    Combo1.AddItem "<= ", 4
    Combo1.AddItem "<> ", 5
    Combo1.AddItem "= ", 6
    Combo1.ListIndex = 0
  End Select
End Sub

Private Sub CmdSql_Click(Index As Integer)
    Select Case Index
    Case 0
        If Me.TxtSQL.Text = "" Then
            intNumField = -1
        Else
            If Combo1.Text = "包含" Then
                 temp2 = "like "
                 temp3 = "*" & TxtSQL.Text & "*"
            Else
                 temp2 = Combo1.Text
                 temp3 = TxtSQL.Text
            End If
            Select Case a(CboField.ListIndex)
                   Case 2
                      strSqlField = " " & temp2 & temp3
                   Case 7
                      strSqlField = " " & temp2 & "#" & temp3 & "#"
                   Case Else
                      strSqlField = " " & temp2 & "'" & temp3 & "'"
            End Select
            intNumField = CboField.ListIndex
        End If
    Case 1
        intNumField = -2
    End Select
    Unload Me
End Sub

Private Sub DTPicker1_Change()
    TxtSQL.Text = DTPicker1.Value
End Sub

Private Sub Form_Load()
On Error GoTo err_1
  MakeWindow Me

  Dim db As ADODB.Connection
  Dim adoPrimaryRS  As ADODB.Recordset
  Set db = New ADODB.Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("ziliao.lbl")

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select * from " & sqlado, db, adOpenStatic, adLockOptimistic
  Dim intTmp As Integer
  For intTmp = 0 To intNumField - 1
      Me.CboField.AddItem adoPrimaryRS.Fields(intTmp).Name
      a(intTmp) = adoPrimaryRS.Fields(intTmp).Type
  Next
  CboField.ListIndex = 0
  adoPrimaryRS.Close
  db.Close
  DTPicker1.Value = Date
Exit Sub
err_1:
  MsgBox Err.Description, vbCritical
End Sub

Private Sub imgTitleClose_Click()
    intNumField = -2
    Unload Me
End Sub

Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMinimize_Click()
    Me.WindowState = 1
End Sub

Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

===========================================

补充：VB ,  数据库(包含打印，安装，报表)