ASP实例代码 asp操作Excel类

ASP实例代码asp操作Excel类

asp操作Excel类:

<%

，*************************><****秦************************************

'使用说明

Dima

'Seta=newCreateExcel

'a.SavePath="x"'保存路径

,a.SheetName="工作簿名称"哆个工作表a.SheelName=array("工作簿名称一"，"工作

簿名称二")

，a.SheetTitle="表名称"’可以为空多个工作表a.ShcuNamc=array("表名称一"，"表

名称二")

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

Dimrs

,Setrs=server.CreateObjecl("Adodb.RecoidSet")

'rs.open"Selectid,classid,classNaniefrom[class]",conn,1,I

,a.AddDBDatars,"字段名一，字段名二"，"工作簿名称"，"表名称"，true'true自动获

取表字段名

,a.AddDatac,true，”工作簿名称"，”表名称"'c二维数组true第一行是否为标

题行

,a.AddtDatae,"Sheet1"'按模板生成c=array(array(“AAl"，”内容)array。AA2"，“内容

2°))

'a.CrcatcO

,a.UsedTime生成时间，亳秒数

,a.SavePath保存路径

'Seta=no(hing

，设置COM组件的操作权限。在命令行键入"DCOMCNFG"，则进入COM组件配置界面，

选择MicrosoftExcel后点击属性按钮，将三个单选项一律选择自定义，编辑中将Everyone

加入所有权限

，本*才******木****木木京***木*本本木木***木*木木木*****木***去木木木****去京木**东

ClassCreateExcel

PrivateCrcatcType_

PrivatesavePath_

PrivatereadPath_

PrivateAuthorStrRem设置作者

PrivateVersionStrRem设置版本

PrivateSystemStrRem设置系统名称

PrivateShectNamc_Rem设置表名

PrivateSheetTitle_Rem设置标题

PrivateExcelDataRem设置表数据

PrivateExcelAppRemExcel.Application

PrivateExcelBook

PrivateExcelSheets

PrivateUsedTime_Rem使用的时间

PublicTitleFirstLineRem首行是否标题

PrivateSubClass_Initialize()

Server.ScriplTimeOut=99999

UsedTime_=Timer

SystcmStr="LcOO_CrcatcExcclServer,

AuthorStr="Surnfusurnfu@126.com31333716"

VersionStr="1.0"

ifnotIsObjInstallcd(Excel.Application)then

InErr("服务器未安装Excel.Application控件")

endif

setExcclApp=crcatcObjcct("Exccl.Application")

ExcelApp.DisplayAlerts=false

ExcelApp.Application.Visible=false

Crca(cTypc_=1

readPath_=null

EndSub

PrivateSubClass_Terminate()

ExcclApp.Quit

IfIsobjcct(ExcclShccts)ThenSetExcclShcctsNothing

IfIsobject(ExcelBook)ThenSetExcelBook=Nothing

IfIsobjec((ExcelApp)ThenSetExcelApp=Nothing

EndSub

PublicPropertyLetReadPath(ByValVai)

IfInstr(Val,'W'joOThen

readPalh_=Trim(Val)

else

rcadPath_=Scrver.MapPath(Triin(Val))

endif

EndProperty

PublicPropertyLetSavePc；th(ByValVai)

IfInstr(Val,M:\")<>0Then

savePath_=Trim(Vai)

else

savePath_=Server.MapPath(Trim(Val))

endif

EndProperty

PublicPropertyLetCreateType(ByVaiVai)

ifVai<>1andVai<>2then

Createlype_=1

else

CrcateTypc_=Vai

endif

EndProperty

PublicPropertyLetData(ByValVai)

ifnotisArray(Val)then

InErr(”表数据设置有误")

endif

ExcelData=Vai

EndProperly

PublicPropertyGetSavePath()

SavePath=savePath_

EndProperty

PublicPropertyGetUsedTime()

UsedTime=UsedTime_

EndProperty

PublicPropertyLetSheetName(ByValVai)

ifnotisArray(Val)then

ifVai=H"then

InEnT表名设置有误")

endif

TitlcFirstLine=(rue

else

ReDiniTitleFirstLine(Ubound(Val))

Dimik_

Forik_=0toUbound(Val)

TitleFirstLine(ik_)=true

Next

endif

SheetName_=Vai

EndProperty

PublicPropertyLetSheetTitle(ByValVai)

ifnotisArray(Val)then

ifVal=""then

InErrC表标题设置有误”)

endif

endif

ShcetTitle_=Vai

EndProperty

Rem检查数据

PrivateSubCheckData()

ifsavePath.=""thenInErr("保存路径不能为空")

ifnotisArray(ShcctName_)then

ifSheetName_=""thenInErr("表名不能为空”)

endif

ifCreateType_=2then

ifnotisArray(ExcelData)then

InEnT数据我入错误，或者未载入")

endif

ExitSub

endif

ifisArray(SheetNanie_)then

ifnotisArray(ShcctTitlc_)then

ifSheetTitle_<>thenInEE”表标题设置有误，与表名不对应")

endif

endif

ifnotIsArray(ExcelData)then

InErr("表数据载人有误")

endif

ifisArray(SheetName_)then

ifGetArrayDim(ExcelData)<>1thenInErr("表数据载入有误,数据格式错误,

维度应该为一”)

else

ifGetArrayDim(ExcelData)<>2thenInErr("表数据载入有误，数据格式错误,

维度应该为二”)

endif

EndSub

Rem生成Excel

PublicFunctionCreateO

CallCheckData()

ifnotisnull(rcadPaih_)then

ExcelApp.WorkBooks.Open(readPath_)

else

ExcelApp.WorkBooks.add

endif

setExcclBook=ExcelApp.ActiveWorkBook

setExcelSheets=ExcelBook.Worksheets

ifCreatcTypc_=2then

Dimih_

Forih_=0toUbound(ExcelData)

CallSetSheets(ExcelData(ih_),ih_)

Next

ExcelBook.SavcAssavcPath_

UsedTime_=FormatNumber((Timer-UsedTime_)*1(XX),3)

ExitFunction

endif

ifIsArray(SheetNanie_)then

Dimik_

Forik_=0toUbound(ExcelData)

CallCreateSheets(ExcelData(ik_),ik_)

Next

else

CallCreateSheets(ExcelData,-1)

endif

ExcelBook.SaveAssavePath_

Usc<iTimc_=FormatNunibcr((Timcr-UscdTimc_)*1000,3)

EndFunction

PrivateSubCrcatcShccts(ByValData_,Datald_)

DimSpreadsheet

DimtempSheetTitle

DimtempTitleFirstLine

ifDatald_<>-1then

ifDatald_>ExcelSheets.Count-1then

ExcelSheets.Add()

setSpreadsheet=ExcelBook.Shccts(1)

else

setSpreadsheet=ExcelBook.Sheets(DataId_+1)

endif

ifisArray(SheetTitle_)then

tempSheetTitle=SheetTitle_(DataId_)

else

tempSheetTitle=""

endif

tempTitleFirstLine=TitlcFirstLinc(DataId_)

Spreadsheet.Nair.e=SheetName_(DataId_)

else

setSpreadsheet=ExcelBook.Shccts(1)

Spreadsheet.Naire=SheetName_

tempSheetTitle=SheetTitle_

tempTitleFirstLine=TitlcFirstLine

endif

DiniLine:Line=I

DimRovvNum_:RowNum_=Ubound(Data_,1)+1

DimLastCols_

if(cmpShcctTitlco""then

,Spreadsheet.Columns(1).ShrinkToFil=true，设定是否自动适应表格单元大小(单

元格宽不变）

LastCols_=gc(ColNamc(Ubound(Da(a_,2)+1)

withSpreadsheet.Cells(1,1)

.value=tenipSheetTitle

，设置Excel表里的字体

.Font.Bold=True'单元格字体加粗

.Font.Italic=False'单元格字体倾斜

.Font.Size=20'设置单元格字号

.="宋体"'设置单元格字体

〔fonl.ColorIndex=2,设置单元格文字的颜色，颜色可以查询，2为白色

Endwith

withSpreadsheet.Range("AlLastCols_&"1")

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

'.Intcrior.Coorlndcx=1'设计单元络背景色

.HorizontalAlignment=3'居中

Endwith

Line=2

RowNum_=Ro\vNum_+1

endif

DiiniRow_,iCoI_

DimdRow_,dCol_

DimtempLastRange:tempLastRange=getColName(Ubound(Data_,2)+1)&

(RowNum_)

DimBeginRow:BeginRow=I

if(cmpShcctTitlco""thenBcginRow=BeginRow+1

iftemp1'itleFirstLine=truethenBeginRow=BeginRow+1

ifBcginRow=lthen

withSpreadsheet.Range("A1tempLastRange)

.Borders.LireStyle=1

.BordcrAround-4119,-4138'设置外框

.NuniberFomiatLocal=，文本格式

.Font.Bold=False

.Font.Italic=False

.Font.Size=10

.ShrinkToFii=truc

endwith

else

withSpreadsheet.Range("AItempLastRange)

.Borders.LineStyle=1

.BorderAround-4119,-4138

.ShrinkToFi:=truc

endwith

withSprcadshcct.Rangc("A"&BcginRowtcmpLastRangc)

.NuniberFomiatLocal=

.Font.Bold=False

.Font.Italic=False

.Font.Size=10

endwith

endif

iftempTitleFirstLine=truethen

BcginRow=1

iftempSheetTitle<>""thenBeginRow=BeginRow+1

withSpreadsheet.Rangc("A"&BcginRowgctColNamc(Ubound(Data_,

2)+1)&(BeginRow))

.NuniberFomiatLocal=

.Font.Bold=True

.Font.Italic=False

.Font.Size=12

.Interior.Colorlndex=37

.HorizontalAlignment=3'居中

.fon(.Color!ndex=2

endwith

endif

ForiRow_=Line_ToRowNuin_

ForiCol_=1To(Ubound(Data_,2)+1)

dCol_=iCol_-1

iftcnipShee:Title<>""thendRow_=iRow_-2elsedRow_=iRow_-1

IfnotIsNull(Data_(dRow_,dCol_))then

withSpreadsheet.Cells(iRow_,iCol_)

.Value=Data_(dRow_,dCol_)

Endwith

EndIf

Next

Next

setSpreadsheet=Nothing

EndSub

Rem测试组件是否己经安装

PrivateFunctionIsObjlnsUlled(strClassString)

OnEITOFResumeNext

IsObjInstalled=False

Err=0

DimxTestObj

SetxTestObj=ServerCreateObject(strClassString)

If0=ErrThenIsObjlnswww.shanxiwang.ncUallcd=True

SetxTestObj=Nothing

Err=0

EndFunction

Rem取得数组维数

PrivateFunctionGetAnayDim(ByValarr)

GetArrayDiin=Null

Dimi_,temp

IfIsArray(arr)Then

Fori_=1To60

OnErrorResumeNext

temp=UBound(arr,i_)

IfErr.Number<>0Then

GetArnyDim=i_-1

Err.Clcar

ExitFunction

EndIf

Next

GetArrayDim=i_

EndIf

EndFunction

PrivateFunctionGetNumFormatLocal(DataTypc)

SelectCaseDataType

Case"Currency":

GctNumFormatLocal="¥#.##0.00_);(¥#.##0.00)"

Case"Time":

GetNumForinatLocal="[$-F800]dddd.mmmmdd,yyyy"

Case"Char":

GetNumFonnatL(x:al=

Case"Common":

GctNumFonnaiLocal="G/通用格式”

Case"Number":

GetNumForinatLocal="#,##().00^"

Caseelse:

GetNumFormatL(x:al=

EndSelect

EndFunction

PublicSubAddDBData(ByValRsFlied,ByVaiFliedTitle,ByVaitempSheetName_,ByVai

tempSheetTitle_,DBTitle)

ifRsFlied.EofthenExitSub

DimcolNum_:colNum_=RsFlied.fields.count

DimRownurn_:Rownum_=RsFlicd.RccordCount

DimArrFliedTitle

ifDBTidc=true(hen

FliedTitle=""

Dimig_

Forig_=0(ocolNum_-I

FliedTitle=FliedTitle&RsFlied.fields.item(ig_).nanie

ifig_<>colNum--IthenFliedTitle=FliedTitle

Next

endif

ifFlicdTitlco""then

Rownum_=Rownum_+1

ArrFliedTitle=Split(FliedTitle,

ifUbound(ArrFliedTitle)<>colNum_-Ithen

InErr("获取数据库表有误，列数不符”)

endif

endif

DinitempData:ReDintempData(Rownum_-1.colNum_-1)

Dimix_,iy_

Dimiz

ifFiiedTitleo""theniz=Rownum--2elseiz=Rownum_-I

Forix_=0Toiz

Foriy_=OTocolNum_-1

ifFlicdTitleo"1'then

ifix_=()then

tempData(ix_,iy_)=ArrFiiedTitle(iy_)

tcnipData(ix_+1.iy_)=RsFlied(iy_)

else

tenipData(ix_+1,iy_)=RsFiied(iy_)

endif

else

tenipData(ix_,iy_)=RsFlied(iy_)

endif

Next

RsFlied.MoveNext

Next

DimtempFirstLine

ifFliedTitleo""thentempFirstLine=trueelsetempFirstLine=false

CallAddData(tempData,tempFirstLine,tempSheetName_,tempSheetTitle_)

EndSub

PublicSubAddData(ByValtempDate_,ByVaitempFirstLine_,ByVaitempSheetName_,

ByVaitempSheetTitle_)

ifnotisArray(ExcclData)(hen

ExcelData=tempDate_

TitleFirstLine=tempFirstLine.

ShcctNamc_=tcinpShcctNamc_

SheetTitle_=tenipSheetTitle_

else

ifGctArrayDim(ExcclData)=1then

DimtempArrLen:tenipAiTLen=Ubound(ExcelData)+1

ReDiniPreserveExcelData(tempArrLen)

ExcelDa(a(tcmpArrLcn)=(crnpDaic_

ReDiniPreserveTilleFirstLine(tempArrLen)

TitleFirstLine(tenipArrLen)=tempFirstLine.

RcDimPreserveShcc(Namc_((ctnpArrLcn)

SheetName_(tempArrLen)=tempSheetName_

RcDimPreserveShcctTitlc_(tcinpArrLcn)

ShcctTitlc_((cmpArrLcn)=tcnipShcctTitlc_

else

DimtempOldData:tempOldData=ExcelData

ExcelData=Array(tcmpOldData,tcmpDate_)

TitleFirstLine=Array(TitleFirstLine,tempFirstLine.)

SheetName_=Array(SheetName_,tempSheetName_)

ShcctTitlc_=Array(SheetTitle_,tempShcctTitle_)

endif

endif

EndSub

Rem模板增加数据方法

PublicSubAddtData(ByValtempDate_,ByVaitempSheetName_)

CrcateType_=2

ifnotisArray(ExcelData)then

ExcelData=Array(tenipDate_)

ShcctNamc_=Array(tcmpSheetNatnc_)

else

DimtempArrLen:tempArrLen=Ubound(ExcelData)+1

RcDimPreserveExcelDataftempArrLen)

ExcelData(tempArrLen)=tempDate_

ReDiniPreserveSheetName_(tempArrLen)

ShcctNamc_(tempArrLzen)=tcinpShcetNamc_

Endif

EndSub

PrivateSubSetSheets(ByViilData_,Datald_)

DiniSpreadsheet

setSpreadsheet=ExcelBook.Shccts(ShcctNamc_(DataId_))

Spreadsheet.Activate

Dimix_

Forix_=0ToUbound(Da(a_)

ifnotisArray(Data_(ix_))thenInEE"表数据载入有误，数据格式错误")

ifUbound(Data_(ix_»<>IthenInErr("表数据载入有误,数据格式错误")

Spreadsheet.Rangc(Data_(ix_)(O)).valuc=Data_(ix_)(l)

Next

setSpreadsheet=Nothing

EndSub

PublicFunctionGetrime(msec_)

DimReTime_:ReTinie_=""

ifmscc_<1000(hen

ReTime_=msec_&"MS"

else

Dimsccond_

second_=(msec_\1000)

if(mscc_modIC<X))<>0then

mscc_=(msec-mod1000)&"亳秒”

else

msec_=""

endif

Dimn_,aryTime(2),aryTimeunit(2)

aryTimeunit(O)="秒”

aryTimcunil(l)="分"

aryTimeunit(2)="小时"

n_=0

DimtcmpSecond_:tempSecond_=second_

While(tempSecond_/60>=1)

tempSecond,=Fix(tempSecond_/60*100)/00

n_=n_+1

WEnd

Dimm_

Form_=n_ToCStep-1

aryTime(m_)=second_\(60Am_)

second_=second,mod(60Am_)

ReTimc_=RcTime_&aryTime(m_)&aryTim£unit(m_)

Next

ifmsec_<>""(henRcTime_=RcTirne.&nisec_

endif

Getlime=ReJinie_

endFunction

Rem取得列名

PrivateFunctiongetColNanie(ByValColNum)

DimArrlitter:Arrliticr=split("ABCDEFGHIJKLMNOPQRSTUVWXY

Z","")

DimReValue_

ifColNum<=Ubound(Arrlitter)+Ithen

ReValue_=Arrlitter(ColNum-1)

else

RcValue.=Arrliitcr(<(ColNum-1)\26))&ArrliUcr(<(ColNum-l)mod26))

endif

getColName=ReValue_

EndFunction

Rem设置错误

PrivateSubInErr(Errlnfo)

Err.RaisevbObj