代碼如下:
<%
'*******************************************************************
'使用說(shuō)明
'dim a
'set a=new createexcel
'a.savepath=x '保存路徑
'a.sheetname=工作簿名稱 '多個(gè)工作表 a.sheetname=array(工作簿名稱一,工作簿名稱二)
'a.sheettitle=表名稱 '可以為空 多個(gè)工作表 a.sheetname=array(表名稱一,表名稱二)
'a.data =d '二維數(shù)組 '多個(gè)工作表 array(b,c) b與c為二維數(shù)組
'dim rs
'set rs=server.createobject(adodb.recordset)
'rs.open select id, classid, classname from [class] ,conn, 1, 1
'a.adddbdata rs, 字段名一，字段名二, 工作簿名稱, 表名稱, true 'true自動(dòng)獲取表字段名
'a.adddata c, true , 工作簿名稱, 表名稱 'c二維數(shù)組 true 第一行是否為標(biāo)題行
'a.addtdata e, sheet1 '按模板生成 c=array(array(aa1, 內(nèi)容), array(aa2, 內(nèi)容2))
'a.create()
'a.usedtime 生成時(shí)間，毫秒數(shù)
'a.savepath 保存路徑
'set a=nothing
'設(shè)置com組件的操作權(quán)限。在命令行鍵入“dcomcnfg”，則進(jìn)入com組件配置界面，選擇microsoftexcel后點(diǎn)擊屬性按鈕，將三個(gè)單選項(xiàng)一律選擇自定義，編輯中將everyone加入所有權(quán)限
'*******************************************************************
class createexcel
private createtype_
private savepath_
private readpath_
private authorstr rem 設(shè)置作者
private versionstr rem 設(shè)置版本
private systemstr rem 設(shè)置系統(tǒng)名稱
private sheetname_ rem 設(shè)置表名
private sheettitle_ rem 設(shè)置標(biāo)題
private exceldata rem 設(shè)置表數(shù)據(jù)
private excelapp rem excel.application
private excelbook
private excelsheets
private usedtime_ rem 使用的時(shí)間
public titlefirstline rem 首行是否標(biāo)題
private sub class_initialize()
server.scripttimeout = 99999
usedtime_ = timer
systemstr = lc00_createexcelserver
authorstr = surnfu 31333716
versionstr = 1.0
if not isobjinstalled(excel.application) then
inerr(服務(wù)器未安裝excel.application控件)
end if
set excelapp = createobject(excel.application)
excelapp.displayalerts = false
excelapp.application.visible = false
createtype_ = 1
readpath_ = null
end sub
private sub class_terminate()
excelapp.quit
if isobject(excelsheets) then set excelsheets = nothing
if isobject(excelbook) then set excelbook = nothing
if isobject(excelapp) then set excelapp = nothing
end sub
public property let readpath(byval val)
if instr(val, :)<>0 then
readpath_ = trim(val)
else
readpath_=server.mappath(trim(val))
end if
end property
public property let savepath(byval val)
if instr(val, :)<>0 then
savepath_ = trim(val)
else
savepath_=server.mappath(trim(val))
end if
end property
public property let createtype(byval val)
if val <> 1 and val <> 2 then
createtype_ = 1
else
createtype_ = val
end if
end property
public property let data(byval val)
if not isarray(val) then
inerr(表數(shù)據(jù)設(shè)置有誤)
end if
exceldata = val
end property
public property get savepath()
savepath = savepath_
end property
public property get usedtime()
usedtime = usedtime_
end property
public property let sheetname(byval val)
if not isarray(val) then
if val = then
inerr(表名設(shè)置有誤)
end if
titlefirstline = true
else
redim titlefirstline(ubound(val))
dim ik_
for ik_ = 0 to ubound(val)
titlefirstline(ik_) = true
next
end if
sheetname_ = val
end property
public property let sheettitle(byval val)
if not isarray(val) then
if val = then
inerr(表標(biāo)題設(shè)置有誤)
end if
end if
sheettitle_ = val
end property
rem 檢查數(shù)據(jù)
private sub checkdata()
if savepath_ = then inerr(保存路徑不能為空)
if not isarray(sheetname_) then
if sheetname_ = then inerr(表名不能為空)
end if
if createtype_ = 2 then
if not isarray(exceldata) then
inerr(數(shù)據(jù)載入錯(cuò)誤，或者未載入)
end if
exit sub
end if
if isarray(sheetname_) then
if not isarray(sheettitle_) then
if sheettitle_ <> then inerr(表標(biāo)題設(shè)置有誤，與表名不對(duì)應(yīng))
end if
end if
if not isarray(exceldata) then
inerr(表數(shù)據(jù)載入有誤)
end if
if isarray(sheetname_) then
if getarraydim(exceldata) <> 1 then inerr(表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯(cuò)誤，維度應(yīng)該為一)
else
if getarraydim(exceldata) <> 2 then inerr(表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯(cuò)誤，維度應(yīng)該為二)
end if
end sub
rem 生成excel
public function create()
call checkdata()
if not isnull(readpath_) then
excelapp.workbooks.open(readpath_)
else
excelapp.workbooks.add
end if
set excelbook = excelapp.activeworkbook
set excelsheets = excelbook.worksheets
if createtype_ = 2 then
dim ih_
for ih_ = 0 to ubound(exceldata)
call setsheets(exceldata(ih_), ih_)
next
excelbook.saveas savepath_
usedtime_ = formatnumber((timer - usedtime_)*1000, 3)
exit function
end if
if isarray(sheetname_) then
dim ik_
for ik_ = 0 to ubound(exceldata)
call createsheets(exceldata(ik_), ik_)
next
else
call createsheets(exceldata, -1)
end if
excelbook.saveas savepath_
usedtime_ = formatnumber((timer - usedtime_)*1000, 3)
end function
private sub createsheets(byval data_, dataid_)
dim spreadsheet
dim tempsheettitle
dim temptitlefirstline
if dataid_<>-1 then
if dataid_ > excelsheets.count - 1 then
excelsheets.add()
set spreadsheet = excelbook.sheets(1)
else
set spreadsheet = excelbook.sheets(dataid_ + 1)
end if
if isarray(sheettitle_) then
tempsheettitle = sheettitle_(dataid_)
else
tempsheettitle =
end if
temptitlefirstline = titlefirstline(dataid_)
spreadsheet.name = sheetname_(dataid_)
else
set spreadsheet = excelbook.sheets(1)
spreadsheet.name = sheetname_
tempsheettitle = sheettitle_
temptitlefirstline = titlefirstline
end if
dim line_ : line_ = 1
dim rownum_ : rownum_ = ubound(data_, 1) + 1
dim lastcols_
if tempsheettitle <> then
'spreadsheet.columns(1).shrinktofit=true '設(shè)定是否自動(dòng)適應(yīng)表格單元大小(單元格寬不變）
lastcols_ = getcolname(ubound(data_, 2) + 1)
with spreadsheet.cells(1, 1)
.value = tempsheettitle
'設(shè)置excel表里的字體
.font.bold = true '單元格字體加粗
.font.italic = false '單元格字體傾斜
.font.size = 20 '設(shè)置單元格字號(hào)
.font.name=宋體 '設(shè)置單元格字體
'.font.colorindex=2 '設(shè)置單元格文字的顏色，顏色可以查詢，2為白色
end with
with spreadsheet.range(a1:& lastcols_ &1)
.merge '合并單元格(單元區(qū)域)
'.interior.colorindex = 1 '設(shè)計(jì)單元絡(luò)背景色
.horizontalalignment = 3 '居中
end with
line_ = 2
rownum_ = rownum_ + 1
end if
dim irow_, icol_
dim drow_, dcol_
dim templastrange : templastrange = getcolname(ubound(data_, 2)+1) & (rownum_)
dim beginrow : beginrow = 1
if tempsheettitle <> then beginrow = beginrow + 1
if temptitlefirstline = true then beginrow = beginrow + 1
if beginrow=1 then
with spreadsheet.range(a1:& templastrange)
.borders.linestyle = 1
.borderaround -4119, -4138 '設(shè)置外框
.numberformatlocal = @ '文本格式
.font.bold = false
.font.italic = false
.font.size = 10
.shrinktofit=true
end with
else
with spreadsheet.range(a1:& templastrange)
.borders.linestyle = 1
.borderaround -4119, -4138
.shrinktofit=true
end with
with spreadsheet.range(a& beginrow &:& templastrange)
.numberformatlocal = @
.font.bold = false
.font.italic = false
.font.size = 10
end with
end if
if temptitlefirstline = true then
beginrow = 1
if tempsheettitle <> then beginrow = beginrow + 1
with spreadsheet.range(a& beginrow &:& getcolname(ubound(data_, 2)+1) & (beginrow))
.numberformatlocal = @
.font.bold = true
.font.italic = false
.font.size = 12
.interior.colorindex = 37
.horizontalalignment = 3 '居中
.font.colorindex=2
end with
end if
for irow_ = line_ to rownum_
for icol_ = 1 to (ubound(data_, 2) + 1)
dcol_ = icol_ - 1
if tempsheettitle <> then drow_ = irow_ - 2 else drow_ = irow_ - 1
if not isnull(data_(drow_, dcol_)) then
with spreadsheet.cells(irow_, icol_)
.value = data_(drow_, dcol_)
end with
end if
next
next
set spreadsheet = nothing
end sub
rem 測(cè)試組件是否已經(jīng)安裝
private function isobjinstalled(strclassstring)
on error resume next
isobjinstalled = false
err = 0
dim xtestobj
set xtestobj = server.createobject(strclassstring)
if 0 = err then isobjinstalled = true
set xtestobj = nothing
err = 0
end function
rem 取得數(shù)組維數(shù)
private function getarraydim(byval arr)
getarraydim = null
dim i_, temp
if isarray(arr) then
for i_ = 1 to 60
on error resume next
temp = ubound(arr, i_)
if err.number <> 0 then
getarraydim = i_ - 1
err.clear
exit function
end if
next
getarraydim = i_
end if
end function
private function getnumformatlocal(datatype)
select case datatype
case currency:
getnumformatlocal = ￥#,##0.00_);(￥#,##0.00)
case time:
getnumformatlocal = [$-f800]dddd, mmmm dd, yyyy
case char:
getnumformatlocal = @
case common:
getnumformatlocal = g/通用格式
case number:
getnumformatlocal = #,##0.00_
case else :
getnumformatlocal = @
end select
end function
public sub adddbdata(byval rsflied, byval fliedtitle, byval tempsheetname_, byval tempsheettitle_, dbtitle)
if rsflied.eof then exit sub
dim colnum_ : colnum_ = rsflied.fields.count
dim rownum_ : rownum_ = rsflied.recordcount
dim arrfliedtitle
if dbtitle = true then
fliedtitle =
dim ig_
for ig_=0 to colnum_ - 1
fliedtitle = fliedtitle & rsflied.fields.item(ig_).name
if ig_ <> colnum_ - 1 then fliedtitle = fliedtitle &,
next
end if
if fliedtitle<> then
rownum_ = rownum_ + 1
arrfliedtitle = split(fliedtitle, ,)
if ubound(arrfliedtitle) <> colnum_ - 1 then
inerr(獲取數(shù)據(jù)庫(kù)表有誤，列數(shù)不符)
end if
end if
dim tempdata : redim tempdata(rownum_ - 1, colnum_ - 1)
dim ix_, iy_
dim iz
if fliedtitle<> then iz = rownum_ - 2 else iz = rownum_ - 1
for ix_ = 0 to iz
for iy_ = 0 to colnum_ - 1
if fliedtitle<> then
if ix_=0 then
tempdata(ix_, iy_) = arrfliedtitle(iy_)
tempdata(ix_ + 1, iy_) = rsflied(iy_)
else
tempdata(ix_ + 1, iy_) = rsflied(iy_)
end if
else
tempdata(ix_, iy_) = rsflied(iy_)
end if
next
rsflied.movenext
next
dim tempfirstline
if fliedtitle<> then tempfirstline = true else tempfirstline = false
call adddata(tempdata, tempfirstline, tempsheetname_, tempsheettitle_)
end sub
public sub adddata(byval tempdate_, byval tempfirstline_, byval tempsheetname_, byval tempsheettitle_)
if not isarray(exceldata) then
exceldata = tempdate_
titlefirstline = tempfirstline_
sheetname_ = tempsheetname_
sheettitle_ = tempsheettitle_
else
if getarraydim(exceldata) = 1 then
dim temparrlen : temparrlen = ubound(exceldata)+1
redim preserve exceldata(temparrlen)
exceldata(temparrlen) = tempdate_
redim preserve titlefirstline(temparrlen)
titlefirstline(temparrlen) = tempfirstline_
redim preserve sheetname_(temparrlen)
sheetname_(temparrlen) = tempsheetname_
redim preserve sheettitle_(temparrlen)
sheettitle_(temparrlen) = tempsheettitle_
else
dim tempolddata : tempolddata = exceldata
exceldata = array(tempolddata, tempdate_)
titlefirstline = array(titlefirstline, tempfirstline_)
sheetname_ = array(sheetname_, tempsheetname_)
sheettitle_ = array(sheettitle_, tempsheettitle_)
end if
end if
end sub
rem 模板增加數(shù)據(jù)方法
public sub addtdata(byval tempdate_, byval tempsheetname_)
createtype_ = 2
if not isarray(exceldata) then
exceldata = array(tempdate_)
sheetname_ = array(tempsheetname_)
else
dim temparrlen : temparrlen = ubound(exceldata)+1
redim preserve exceldata(temparrlen)
exceldata(temparrlen) = tempdate_
redim preserve sheetname_(temparrlen)
sheetname_(temparrlen) = tempsheetname_
end if
end sub
private sub setsheets(byval data_, dataid_)
dim spreadsheet
set spreadsheet = excelbook.sheets(sheetname_(dataid_))
spreadsheet.activate
dim ix_
for ix_ =0 to ubound(data_)
if not isarray(data_(ix_)) then inerr(表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯(cuò)誤)
if ubound(data_(ix_)) <> 1 then inerr(表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯(cuò)誤)
spreadsheet.range(data_(ix_)(0)).value = data_(ix_)(1)
next
set spreadsheet = nothing
end sub
public function gettime(msec_)
dim retime_ : retime_=
if msec_ < 1000 then
retime_ = msec_ &ms
else
dim second_
second_ = (msec_ 1000)
if (msec_ mod 1000)<>0 then
msec_ = (msec_ mod 1000) &毫秒
else
msec_ =
end if
dim n_, arytime(2), arytimeunit(2)
arytimeunit(0) = 秒
arytimeunit(1) = 分
arytimeunit(2) = 小時(shí)
n_ = 0
dim tempsecond_ : tempsecond_ = second_
while(tempsecond_ / 60 >= 1)
tempsecond_ = fix(tempsecond_ / 60 * 100) / 100
n_ = n_ + 1
wend
dim m_
for m_ = n_ to 0 step -1
arytime(m_) = second_ (60 ^ m_)
second_ = second_ mod (60 ^ m_)
retime_ = retime_ & arytime(m_) & arytimeunit(m_)
next
if msec_<> then retime_ = retime_ & msec_
end if
gettime = retime_
end function
rem 取得列名
private function getcolname(byval colnum)
dim arrlitter : arrlitter=split(a b c d e f g h i j k l m n o p q r s t u v w x y z, )
dim revalue_
if colnum <= ubound(arrlitter) + 1 then
revalue_ = arrlitter(colnum - 1)
else
revalue_ = arrlitter(((colnum-1) 26)) & arrlitter(((colnum-1) mod 26))
end if
getcolname = revalue_
end function
rem 設(shè)置錯(cuò)誤
private sub inerr(errinfo)
err.raise vbobjecterror + 1, systemstr &(version & versionstr &), errinfo
end sub
end class
dim b(4,6)
dim c(50,20)
dim i, j
for i=0 to 4
for j=0 to 6
b(i,j) =i&-&j
next
next
for i=0 to 50
for j=0 to 20
c(i,j) = i&-&j &我的
next
next
dim e(20)
for i=0 to 20
e(i)= array(a&(i+1), i+1)
next
'使用示例 需要xx.xls模板支持
'set a=new createexcel
'a.readpath = xx.xls
'a.savepath=xx-1.xls
'a.addtdata e, sheet1
'a.create()
'response.write(生成& a.savepath & 使用了 & a.gettime(a.usedtime) &<br>)
'set a=nothing
'使用示例一
set a=new createexcel
a.savepath=x.xls
a.adddata b, true , 測(cè)試c, 測(cè)試c
a.titlefirstline = false '首行是否為標(biāo)題行
a.create()
response.write(生成& a.savepath & 使用了 & a.gettime(a.usedtime) &<br>)
set a=nothing
'使用示例二
set a=new createexcel
a.savepath=y.xls
a.sheetname=工作簿名稱 '多個(gè)工作表 a.sheetname=array(工作簿名稱一,工作簿名稱二)
a.sheettitle=表名稱 '可以為空 多個(gè)工作表 a.sheetname=array(表名稱一,表名稱二)
a.data =b '二維數(shù)組 '多個(gè)工作表 array(b,c) b與c為二維數(shù)組
a.create()
response.write(生成& a.savepath & 使用了 & a.gettime(a.usedtime) &<br>)
set a=nothing
'使用示例三 生成兩個(gè)表
set a=new createexcel
a.savepath=z.xls
a.sheetname=array(工作簿名稱一,工作簿名稱二)
a.sheettitle=array(表名稱一,表名稱二)
a.data =array(b, c) 'b與c為二維數(shù)組
a.titlefirstline = array(false, true) '首行是否為標(biāo)題行
a.create()
response.write(生成& a.savepath & 使用了 & a.gettime(a.usedtime) &<br>)
set a=nothing
'使用示例四 需要數(shù)據(jù)庫(kù)支持
'dim rs
'set rs=server.createobject(adodb.recordset)
'rs.open select id, classid, classname from [class] ,conn, 1, 1
'set a=new createexcel
'a.savepath=a
'a.adddbdata rs, 序號(hào),類別序號(hào),類別名稱, 工作簿名稱, 類別表, false
'a.create()
'response.write(生成& a.savepath & 使用了 & a.gettime(a.usedtime) &<br>)
'set a=nothing
'rs.close
'set rs=nothing
%>