代碼如下:

<%

'*******************************************************************

'使用說(shuō)明

'dim a

'set a=new createexcel

'a.savepath=x '保存路徑

'a.sheetname=工作簿名稱(chēng) '多個(gè)工作表 a.sheetname=array(工作簿名稱(chēng)一,工作簿名稱(chēng)二)

'a.sheettitle=表名稱(chēng) '可以為空 多個(gè)工作表 a.sheetname=array(表名稱(chēng)一,表名稱(chēng)二)

'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, 字段名一，字段名二, 工作簿名稱(chēng), 表名稱(chēng), true 'true自動(dòng)獲取表字段名

'a.adddata c, true , 工作簿名稱(chēng), 表名稱(chēng) '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)名稱(chē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è)置單元格文字的顏色，顏色可以查詢(xún)，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=工作簿名稱(chēng) '多個(gè)工作表 a.sheetname=array(工作簿名稱(chēng)一,工作簿名稱(chēng)二)

a.sheettitle=表名稱(chēng) '可以為空 多個(gè)工作表 a.sheetname=array(表名稱(chēng)一,表名稱(chēng)二)

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(工作簿名稱(chēng)一,工作簿名稱(chēng)二)

a.sheettitle=array(表名稱(chēng)一,表名稱(chēng)二)

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),類(lèi)別序號(hào),類(lèi)別名稱(chēng), 工作簿名稱(chēng), 類(lèi)別表, false

'a.create()

'response.write(生成& a.savepath &　使用了 & a.gettime(a.usedtime) &<br>)

'set a=nothing

'rs.close

'set rs=nothing

%>

更多信息請(qǐng)查看IT技術(shù)專(zhuān)欄