我用的是dao 將data中的數(shù)據(jù)導(dǎo)入到自己創(chuàng)建的excel 對(duì)象中去
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 '邊框設(shè)置
.linestyle = 1 'xlborderlinestylecontinuous
.colorindex = 5 '邊框?yàn)楹谏?1
藍(lán)色=5
.weight = 2 'xlthin
end with
with xlbook.worksheets("sheet1")
.cells(2, 3) = "新病人(1)": .cells(2, 4) = "復(fù)發(fā)(2)":
.cells(2, 5) = "追回(3)":
.cells(2, 6) = "初治失敗(4)": .cells(2, 7) = "遷入
(5)":
.cells(2, 8) = "其他(6)": .cells(2, 9) = "合計(jì)(7)"
.cells(3, 2) = "初治": .cells(6, 2) = "初治": .cells(9,
2) = "初治"
.cells(4, 2) = "復(fù)治": .cells(7, 2) = "復(fù)治": .cells
(10, 2) = "復(fù)治"
.cells(5, 2) = "小計(jì)": .cells(8, 2) = "小計(jì)": .cells
(11, 2) = "小計(jì)"
.cells(2, 1) = " ": .range("a2:b2").select:
xlapp.selection.merge
.cells(3, 1) = "涂陽(yáng)": .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
