代码如下:

<%

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

'使用说明

'dim a

'set a=new createexcel

'a.savepath=x '保存路径

'a.sheetname=工作簿名称 '多个工作表 a.sheetname=array(工作簿名称一,工作簿名称二)

'a.sheettitle=表名称 '可以为空 多个工作表 a.sheetname=array(表名称一,表名称二)

'a.data =d '二维数组 '多个工作表 array(b,c) b与c为二维数组

'dim rs

'set rs=server.createobject(adodb.recordset)

'rs.open select id, classid, classname from [class] ,conn, 1, 1

'a.adddbdata rs, 字段名一，字段名二, 工作簿名称, 表名称, true 'true自动获取表字段名

'a.adddata c, true , 工作簿名称, 表名称 'c二维数组 true 第一行是否为标题行

'a.addtdata e, sheet1 '按模板生成 c=array(array(aa1, 内容), array(aa2, 内容2))

'a.create()

'a.usedtime 生成时间，毫秒数

'a.savepath 保存路径

'set a=nothing

'设置com组件的操作权限。在命令行键入“dcomcnfg”，则进入com组件配置界面，选择microsoftexcel后点击属性按钮，将三个单选项一律选择自定义，编辑中将everyone加入所有权限

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

class createexcel

private createtype_

private savepath_

private readpath_

private authorstr rem 设置作者

private versionstr rem 设置版本

private systemstr rem 设置系统名称

private sheetname_ rem 设置表名

private sheettitle_ rem 设置标题

private exceldata rem 设置表数据

private excelapp rem excel.application

private excelbook

private excelsheets

private usedtime_ rem 使用的时间

public titlefirstline rem 首行是否标题

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(服务器未安装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(表数据设置有误)

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(表名设置有误)

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(表标题设置有误)

end if

end if

sheettitle_ = val

end property

rem 检查数据

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(数据载入错误，或者未载入)

end if

exit sub

end if

if isarray(sheetname_) then

if not isarray(sheettitle_) then

if sheettitle_ <> then inerr(表标题设置有误，与表名不对应)

end if

end if

if not isarray(exceldata) then

inerr(表数据载入有误)

end if

if isarray(sheetname_) then

if getarraydim(exceldata) <> 1 then inerr(表数据载入有误，数据格式错误，维度应该为一)

else

if getarraydim(exceldata) <> 2 then inerr(表数据载入有误，数据格式错误，维度应该为二)

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 '设定是否自动适应表格单元大小(单元格宽不变）

lastcols_ = getcolname(ubound(data_, 2) + 1)

with spreadsheet.cells(1, 1)

.value = tempsheettitle

'设置excel表里的字体

.font.bold = true '单元格字体加粗

.font.italic = false '单元格字体倾斜

.font.size = 20 '设置单元格字号

.font.name=宋体 '设置单元格字体

'.font.colorindex=2 '设置单元格文字的颜色，颜色可以查询，2为白色

end with

with spreadsheet.range(a1:& lastcols_ &1)

.merge '合并单元格(单元区域)

'.interior.colorindex = 1 '设计单元络背景色

.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 '设置外框

.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 测试组件是否已经安装

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 取得数组维数

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(获取数据库表有误，列数不符)

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 模板增加数据方法

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(表数据载入有误，数据格式错误)

if ubound(data_(ix_)) <> 1 then inerr(表数据载入有误，数据格式错误)

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) = 小时

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 设置错误

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

a.titlefirstline = false '首行是否为标题行

a.create()

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

set a=nothing

'使用示例二

set a=new createexcel

a.savepath=y.xls

a.sheetname=工作簿名称 '多个工作表 a.sheetname=array(工作簿名称一,工作簿名称二)

a.sheettitle=表名称 '可以为空 多个工作表 a.sheetname=array(表名称一,表名称二)

a.data =b '二维数组 '多个工作表 array(b,c) b与c为二维数组

a.create()

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

set a=nothing

'使用示例三 生成两个表

set a=new createexcel

a.savepath=z.xls

a.sheetname=array(工作簿名称一,工作簿名称二)

a.sheettitle=array(表名称一,表名称二)

a.data =array(b, c) 'b与c为二维数组

a.titlefirstline = array(false, true) '首行是否为标题行

a.create()

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

set a=nothing

'使用示例四 需要数据库支持

'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, 序号,类别序号,类别名称, 工作簿名称, 类别表, false

'a.create()

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

'set a=nothing

'rs.close

'set rs=nothing

%>

更多信息请查看IT技术专栏