我用的是DAO   将data中的数据导入到自己创建的Excel    对象中去

Sub TableToExcel(nTableName As Integer, nTableData() As Integer)
    FrmQuarterTable.MousePointer = 11
    On Error Resume Next
    Dim i As Integer
    Dim j As Integer
    Dim strYear As String
    Dim strSeason As String
    Dim xlApp, xlBook, xlSheet As Object
    On Error Resume Next
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlsheet1 = xlBook.worksheets(1)
    xlApp.activewindow.tabratio = 0.9
    Select Case nTableName
        Case 11:
            xlBook.worksheets("sheet1").Select
            xlApp.activesheet.range("B1:H1").Select
            xlApp.activecell.formular1c1 = "表1-1  "             

            xlApp.selection.Font.Name = "黑体"
            xlApp.selection.Font.FontStyle = "Bold"
            xlApp.selection.Font.Size = 18
            xlApp.selection.merge
            With xlApp.activesheet.range("a2:i13").Borders  '边框设置
               .LineStyle = 1       'xlBorderLineStyleContinuous
               .ColorIndex = 5                          '边框为黑色=1

蓝色=5
               .Weight = 2                              'xlthin
            End With
            With xlBook.worksheets("sheet1")
                .cells(2, 3) = "新病人(1)": .cells(2, 4) = "复发(2)":

.cells(2, 5) = "追回(3)":

                 .cells(2, 6) = "初治失败(4)": .cells(2, 7) = "迁入

(5)":

                .cells(2, 8) = "其他(6)": .cells(2, 9) = "合计(7)"
                .cells(3, 2) = "初治": .cells(6, 2) = "初治": .cells(9,

2) = "初治"
                .cells(4, 2) = "复治": .cells(7, 2) = "复治": .cells

(10, 2) = "复治"
                .cells(5, 2) = "小计": .cells(8, 2) = "小计": .cells

(11, 2) = "小计"
                .cells(2, 1) = "    ": .range("a2:b2").Select:

xlApp.selection.merge
                .cells(3, 1) = "涂阳": .range("a3:a5").Select:

xlApp.selection.merge
                .cells(6, 1) = "涂阴": .range("a6:a8").Select:

xlApp.selection.merge
                .cells(9, 1) = "未查痰": .range("a9:a11").Select:

xlApp.selection.merge
                .cells(12, 1) = "胸膜炎": .range("a12:b12").Select:

xlApp.selection.merge
                .cells(13, 1) = "其他": .range("a13:b13").Select:

xlApp.selection.merge
                .Columns("f:f").columnwidth = 13
                .range("A1:i13").Select
                With xlApp.selection
                    .HorizontalAlignment = -4108                '水平居

中
                    .VerticalAlignment = -4108                  '垂直居

中
                End With
                For i = 3 To 13
                    For j = 3 To 9
                        .cells(i, j) = nTableData(i - 1, j)
                    Next
                Next
            End With
        Case 12:   ...............

       case 13: .....................

     end select

     For i = 0 To 12
             For j = 0 To 11
                     nTableData(i, j) = 0
            Next
     Next
    xlApp.Visible = True
    FrmQuarterTable.MousePointer = 1

End Sub

                 急盼高手指教！！。。  wolf_coming@126.com

                                        QQ   15433677