我用的是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