ASP实例代码asp操作Excel类
asp操作Excel类：
<%
''
''使用说明
''Dima
''Seta=newCreateExcel
''a.SavePath="x"''保存路径
''a.SheetName="工作簿名称"''多个工作表a.SheetName=array("工作簿名称一","工作簿名称二")
''a.SheetTitle="表名称"''可以为空多个工作表a.SheetName=array("表名称一","表名称二")
''a.Data=d''二维数组''多个工作表array(b,c)b与c为二维数组
''Dimrs
''Setrs=server.CreateObject("Adodb.RecordSet")
''rs.open"Selectid,classid,classNamefrom[class]",conn,1,1
''a.AddDBDatars,"字段名一，字段名二","工作簿名称","表名称",true''true自动获取表字段名
''a.AddDatac,true,"工作簿名称","表名称"''c二维数组true第一行是否为标题行
''a.AddtDatae,"Sheet1"''按模板生成c=array(array("AA1","内容"),array("AA2","内容2"))
''a.Create()
''a.UsedTime生成时间，毫秒数
''a.SavePath保存路径
''Seta=nothing
''设置COM组件的操作权限。在命令行键入“DCOMCNFG”，则进入COM组件配置界面，选择MicrosoftExcel后点击属性按钮，将三个单选项一律选择自定义，编辑中将Everyone加入所有权限
''
ClassCreateExcel
PrivateCreateType_
PrivatesavePath_
PrivatereadPath_
PrivateAuthorStrRem设置作者
PrivateVersionStrRem设置版本
PrivateSystemStrRem设置系统名称
PrivateSheetName_Rem设置表名
PrivateSheetTitle_Rem设置标题
PrivateExcelDataRem设置表数据
PrivateExcelAppRemExcel.Application
PrivateExcelBook
PrivateExcelSheets
PrivateUsedTime_Rem使用的时间
PublicTitleFirstLineRem首行是否标题
PrivateSubClass_Initialize()
Server.ScriptTimeOut=99999
UsedTime_=Timer
SystemStr="Lc00_CreateExcelServer"
AuthorStr="Surnfusurnfu@126.com31333716"
VersionStr="1.0"
ifnotIsObjInstalled("Excel.Application")then
InErr("服务器未安装Excel.Application控件")
endif
setExcelApp=createObject("Excel.Application")
ExcelApp.DisplayAlerts=false
ExcelApp.Application.Visible=false
CreateType_=1
readPath_=null
EndSub
PrivateSubClass_Terminate()
ExcelApp.Quit
IfIsobject(ExcelSheets)ThenSetExcelSheets=Nothing
IfIsobject(ExcelBook)ThenSetExcelBook=Nothing
IfIsobject(ExcelApp)ThenSetExcelApp=Nothing
EndSub
PublicPropertyLetReadPath(ByValVal)
IfInstr(Val,":\")<>0Then
readPath_=Trim(Val)
else
readPath_=Server.MapPath(Trim(Val))
endif
EndProperty
PublicPropertyLetSavePath(ByValVal)
IfInstr(Val,":\")<>0Then
savePath_=Trim(Val)
else
savePath_=Server.MapPath(Trim(Val))
endif
EndProperty
PublicPropertyLetCreateType(ByValVal)
ifVal<>1andVal<>2then
CreateType_=1
else
CreateType_=Val
endif
EndProperty
PublicPropertyLetData(ByValVal)
ifnotisArray(Val)then
InErr("表数据设置有误")
endif
ExcelData=Val
EndProperty
PublicPropertyGetSavePath()
SavePath=savePath_
EndProperty
PublicPropertyGetUsedTime()
UsedTime=UsedTime_
EndProperty
PublicPropertyLetSheetName(ByValVal)
ifnotisArray(Val)then
ifVal=""then
InErr("表名设置有误")
endif
TitleFirstLine=true
else
ReDimTitleFirstLine(Ubound(Val))
Dimik_
Forik_=0toUbound(Val)
TitleFirstLine(ik_)=true
Next
endif
SheetName_=Val
EndProperty
PublicPropertyLetSheetTitle(ByValVal)
ifnotisArray(Val)then
ifVal=""then
InErr("表标题设置有误")
endif
endif
SheetTitle_=Val
EndProperty
Rem检查数据
PrivateSubCheckData()
ifsavePath_=""thenInErr("保存路径不能为空")
ifnotisArray(SheetName_)then
ifSheetName_=""thenInErr("表名不能为空")
endif
ifCreateType_=2then
ifnotisArray(ExcelData)then
InErr("数据载入错误，或者未载入")
endif
ExitSub
endif
ifisArray(SheetName_)then
ifnotisArray(SheetTitle_)then
ifSheetTitle_<>""thenInErr("表标题设置有误，与表名不对应")
endif
endif
ifnotIsArray(ExcelData)then
InErr("表数据载入有误")
endif
ifisArray(SheetName_)then
ifGetArrayDim(ExcelData)<>1thenInErr("表数据载入有误，数据格式错误，维度应该为一")
else
ifGetArrayDim(ExcelData)<>2thenInErr("表数据载入有误，数据格式错误，维度应该为二")
endif
EndSub
Rem生成Excel
PublicFunctionCreate()
CallCheckData()
ifnotisnull(readPath_)then
ExcelApp.WorkBooks.Open(readPath_)
else
ExcelApp.WorkBooks.add
endif
setExcelBook=ExcelApp.ActiveWorkBook
setExcelSheets=ExcelBook.Worksheets
ifCreateType_=2then
Dimih_
Forih_=0toUbound(ExcelData)
CallSetSheets(ExcelData(ih_),ih_)
Next
ExcelBook.SaveAssavePath_
UsedTime_=FormatNumber((Timer-UsedTime_)1000,3)
ExitFunction
endif
ifIsArray(SheetName_)then
Dimik_
Forik_=0toUbound(ExcelData)
CallCreateSheets(ExcelData(ik_),ik_)
Next
else
CallCreateSheets(ExcelData,-1)
endif
ExcelBook.SaveAssavePath_
UsedTime_=FormatNumber((Timer-UsedTime_)1000,3)
EndFunction
PrivateSubCreateSheets(ByValData_,DataId_)
DimSpreadsheet
DimtempSheetTitle
DimtempTitleFirstLine
ifDataId_<>-1then
ifDataId_>ExcelSheets.Count-1then
ExcelSheets.Add()
setSpreadsheet=ExcelBook.Sheets(1)
else
setSpreadsheet=ExcelBook.Sheets(DataId_+1)
endif
ifisArray(SheetTitle_)then
tempSheetTitle=SheetTitle_(DataId_)
else
tempSheetTitle=""
endif
tempTitleFirstLine=TitleFirstLine(DataId_)
Spreadsheet.Name=SheetName_(DataId_)
else
setSpreadsheet=ExcelBook.Sheets(1)
Spreadsheet.Name=SheetName_
tempSheetTitle=SheetTitle_
tempTitleFirstLine=TitleFirstLine
endif
DimLine_:Line_=1
DimRowNum_:RowNum_=Ubound(Data_,1)+1
DimLastCols_
iftempSheetTitle<>""then
''Spreadsheet.Columns(1).ShrinkToFit=true''设定是否自动适应表格单元大小(单元格宽不变）
LastCols_=getColName(Ubound(Data_,2)+1)
withSpreadsheet.Cells(1,1)
.value=tempSheetTitle
''设置Excel表里的字体
.Font.Bold=True''单元格字体加粗
.Font.Italic=False''单元格字体倾斜
.Font.Size=20''设置单元格字号
.font.name="宋体"''设置单元格字体
''.font.ColorIndex=2''设置单元格文字的颜色，颜色可以查询，2为白色
Endwith
withSpreadsheet.Range("A1:"&LastCols_&"1")
.merge''合并单元格(单元区域)
''.Interior.ColorIndex=1''设计单元络背景色
.HorizontalAlignment=3''居中
Endwith
Line_=2
RowNum_=RowNum_+1
endif
DimiRow_,iCol_
DimdRow_,dCol_
DimtempLastRange:tempLastRange=getColName(Ubound(Data_,2)+1)&(RowNum_)
DimBeginRow:BeginRow=1
iftempSheetTitle<>""thenBeginRow=BeginRow+1
iftempTitleFirstLine=truethenBeginRow=BeginRow+1
ifBeginRow=1then
withSpreadsheet.Range("A1:"&tempLastRange)
.Borders.LineStyle=1
.BorderAround-4119,-4138''设置外框
.NumberFormatLocal="@"''文本格式
.Font.Bold=False
.Font.Italic=False
.Font.Size=10
.ShrinkToFit=true
endwith
else
withSpreadsheet.Range("A1:"&tempLastRange)
.Borders.LineStyle=1
.BorderAround-4119,-4138
.ShrinkToFit=true
endwith
withSpreadsheet.Range("A"&BeginRow&":"&tempLastRange)
.NumberFormatLocal="@"
.Font.Bold=False
.Font.Italic=False
.Font.Size=10
endwith
endif
iftempTitleFirstLine=truethen
BeginRow=1
iftempSheetTitle<>""thenBeginRow=BeginRow+1
withSpreadsheet.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
endwith
endif
ForiRow_=Line_ToRowNum_
ForiCol_=1To(Ubound(Data_,2)+1)
dCol_=iCol_-1
iftempSheetTitle<>""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测试组件是否已经安装
PrivateFunctionIsObjInstalled(strClassString)
OnErrorResumeNext
IsObjInstalled=False
Err=0
DimxTestObj
SetxTestObj=Server.CreateObject(strClassString)
If0=ErrThenIsObjInswww.shanxiwang.nettalled=True
SetxTestObj=Nothing
Err=0
EndFunction
Rem取得数组维数
PrivateFunctionGetArrayDim(ByValarr)
GetArrayDim=Null
Dimi_,temp
IfIsArray(arr)Then
Fori_=1To60
OnErrorResumeNext
temp=UBound(arr,i_)
IfErr.Number<>0Then
GetArrayDim=i_-1
Err.Clear
ExitFunction
EndIf
Next
GetArrayDim=i_
EndIf
EndFunction
PrivateFunctionGetNumFormatLocal(DataType)
SelectCaseDataType
Case"Currency":
GetNumFormatLocal="￥#,##0.00_);(￥#,##0.00)"
Case"Time":
GetNumFormatLocal="[$-F800]dddd,mmmmdd,yyyy"
Case"Char":
GetNumFormatLocal="@"
Case"Common":
GetNumFormatLocal="G/通用格式"
Case"Number":
GetNumFormatLocal="#,##0.00_"
Caseelse:
GetNumFormatLocal="@"
EndSelect
EndFunction
PublicSubAddDBData(ByValRsFlied,ByValFliedTitle,ByValtempSheetName_,ByValtempSheetTitle_,DBTitle)
ifRsFlied.EofthenExitSub
DimcolNum_:colNum_=RsFlied.fields.count
DimRownum_:Rownum_=RsFlied.RecordCount
DimArrFliedTitle
ifDBTitle=truethen
FliedTitle=""
Dimig_
Forig_=0tocolNum_-1
FliedTitle=FliedTitle&RsFlied.fields.item(ig_).name
ifig_<>colNum_-1thenFliedTitle=FliedTitle&","
Next
endif
ifFliedTitle<>""then
Rownum_=Rownum_+1
ArrFliedTitle=Split(FliedTitle,",")
ifUbound(ArrFliedTitle)<>colNum_-1then
InErr("获取数据库表有误，列数不符")
endif
endif
DimtempData:ReDimtempData(Rownum_-1,colNum_-1)
Dimix_,iy_
Dimiz
ifFliedTitle<>""theniz=Rownum_-2elseiz=Rownum_-1
Forix_=0Toiz
Foriy_=0TocolNum_-1
ifFliedTitle<>""then
ifix_=0then
tempData(ix_,iy_)=ArrFliedTitle(iy_)
tempData(ix_+1,iy_)=RsFlied(iy_)
else
tempData(ix_+1,iy_)=RsFlied(iy_)
endif
else
tempData(ix_,iy_)=RsFlied(iy_)
endif
Next
RsFlied.MoveNext
Next
DimtempFirstLine
ifFliedTitle<>""thentempFirstLine=trueelsetempFirstLine=false
CallAddData(tempData,tempFirstLine,tempSheetName_,tempSheetTitle_)
EndSub
PublicSubAddData(ByValtempDate_,ByValtempFirstLine_,ByValtempSheetName_,ByValtempSheetTitle_)
ifnotisArray(ExcelData)then
ExcelData=tempDate_
TitleFirstLine=tempFirstLine_
SheetName_=tempSheetName_
SheetTitle_=tempSheetTitle_
else
ifGetArrayDim(ExcelData)=1then
DimtempArrLen:tempArrLen=Ubound(ExcelData)+1
ReDimPreserveExcelData(tempArrLen)
ExcelData(tempArrLen)=tempDate_
ReDimPreserveTitleFirstLine(tempArrLen)
TitleFirstLine(tempArrLen)=tempFirstLine_
ReDimPreserveSheetName_(tempArrLen)
SheetName_(tempArrLen)=tempSheetName_
ReDimPreserveSheetTitle_(tempArrLen)
SheetTitle_(tempArrLen)=tempSheetTitle_
else
DimtempOldData:tempOldData=ExcelData
ExcelData=Array(tempOldData,tempDate_)
TitleFirstLine=Array(TitleFirstLine,tempFirstLine_)
SheetName_=Array(SheetName_,tempSheetName_)
SheetTitle_=Array(SheetTitle_,tempSheetTitle_)
endif
endif
EndSub
Rem模板增加数据方法
PublicSubAddtData(ByValtempDate_,ByValtempSheetName_)
CreateType_=2
ifnotisArray(ExcelData)then
ExcelData=Array(tempDate_)
SheetName_=Array(tempSheetName_)
else
DimtempArrLen:tempArrLen=Ubound(ExcelData)+1
ReDimPreserveExcelData(tempArrLen)
ExcelData(tempArrLen)=tempDate_
ReDimPreserveSheetName_(tempArrLen)
SheetName_(tempArrLen)=tempSheetName_
Endif
EndSub
PrivateSubSetSheets(ByValData_,DataId_)
DimSpreadsheet
setSpreadsheet=ExcelBook.Sheets(SheetName_(DataId_))
Spreadsheet.Activate
Dimix_
Forix_=0ToUbound(Data_)
ifnotisArray(Data_(ix_))thenInErr("表数据载入有误，数据格式错误")
ifUbound(Data_(ix_))<>1thenInErr("表数据载入有误，数据格式错误")
Spreadsheet.Range(Data_(ix_)(0)).value=Data_(ix_)(1)
Next
setSpreadsheet=Nothing
EndSub
PublicFunctionGetTime(msec_)
DimReTime_:ReTime_=""
ifmsec_<1000then
ReTime_=msec_&"MS"
else
Dimsecond_
second_=(msec_\1000)
if(msec_mod1000)<>0then
msec_=(msec_mod1000)&"毫秒"
else
msec_=""
endif
Dimn_,aryTime(2),aryTimeunit(2)
aryTimeunit(0)="秒"
aryTimeunit(1)="分"
aryTimeunit(2)="小时"
n_=0
DimtempSecond_:tempSecond_=second_
While(tempSecond_/60>=1)
tempSecond_=Fix(tempSecond_/60100)/100
n_=n_+1
WEnd
Dimm_
Form_=n_To0Step-1
aryTime(m_)=second_\(60^m_)
second_=second_mod(60^m_)
ReTime_=ReTime_&aryTime(m_)&aryTimeunit(m_)
Next
ifmsec_<>""thenReTime_=ReTime_&msec_
endif
GetTime=ReTime_
endFunction
Rem取得列名
PrivateFunctiongetColName(ByValColNum)
DimArrlitter:Arrlitter=split("ABCDEFGHIJKLMNOPQRSTUVWXYZ","")
DimReValue_
ifColNum<=Ubound(Arrlitter)+1then
ReValue_=Arrlitter(ColNum-1)
else
ReValue_=Arrlitter(((ColNum-1)\26))&Arrlitter(((ColNum-1)mod26))
endif
getColName=ReValue_
EndFunction
Rem设置错误
PrivateSubInErr(ErrInfo)
Err.RaisevbObjectError+1,SystemStr&"(Version"&VersionStr&")",ErrInfo
EndSub
EndClass
Dimb(4,6)
Dimc(50,20)
Dimi,j
Fori=0to4
Forj=0to6
b(i,j)=i&"-"&j
Next
Next
Fori=0to50
Forj=0to20
c(i,j)=i&"-"&j&"我的"
Next
Next
Dime(20)
Fori=0to20
e(i)=array("A"&(i+1),i+1)
Next
''使用示例需要xx.xls模板支持
''Seta=newCreateExcel
''a.ReadPath="xx.xls"
''a.SavePath="xx-1.xls"
''a.AddtDatae,"Sheet1"
''a.Create()
''response.Write("生成"&a.SavePath&"使用了"&a.GetTime(a.UsedTime)&"
")
''Seta=nothing
''使用示例一
Seta=newCreateExcel
a.SavePath="x.xls"
a.AddDatab,true,"测试c","测试c"
a.TitleFirstLine=false''首行是否为标题行
a.Create()
response.Write("生成"&a.SavePath&"使用了"&a.GetTime(a.UsedTime)&"
")
Seta=nothing
''使用示例二
Seta=newCreateExcel
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)&"
")
Seta=nothing
''使用示例三生成两个表
Seta=newCreateExcel
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)&"
")
Seta=nothing
''使用示例四需要数据库支持
''Dimrs
''Setrs=server.CreateObject("Adodb.RecordSet")
''rs.open"Selectid,classid,classNamefrom[class]",conn,1,1
''Seta=newCreateExcel
''a.SavePath="a"
''a.AddDBDatars,"序号,类别序号,类别名称","工作簿名称","类别表",false
''a.Create()
''response.Write("生成"&a.SavePath&"使用了"&a.GetTime(a.UsedTime)&"
")
''Seta=nothing
''rs.close
''Setrs=nothing
%>
|
|
