仓酷云

 找回密码
 立即注册
搜索
热搜: 活动 交友 discuz
查看: 456|回复: 8
打印 上一主题 下一主题

[学习教程] ASP网站制作之ASP实例代码:asp操纵Excel类

[复制链接]
谁可相欹 该用户已被删除
跳转到指定楼层
楼主
发表于 2015-1-16 22:04:03 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
实现规模效益。与传统的用户拥有硬件软件所有权和使用权以及传统的应用服务商提供一对一的服务模式不同,ASP拥有应用系统所有权,用户拥有使用权,应用系统集中放在ASP的数据中心中,集中管理,分散使用,以一对多的租赁的形式为众多用户提供有品质保证的应用技术服务,实现规模效益。</p>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,"字段名一,字段名二","事情簿称号","表称号",truetrue主动猎取表字段名
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)
ifVal1andVal2then
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=ErrThenIsObjInstalled=True
SetxTestObj=Nothing
Err=0
EndFunction
Rem获得数组维数
PrivateFunctionGetArrayDim(ByValarr)
GetArrayDim=Null
Dimi_,temp
IfIsArray(arr)Then
Fori_=1To60
OnErrorResumeNext
temp=UBound(arr,i_)
IfErr.Number0Then
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_/60*100)/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)&"<br>")
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)&"<br>")
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)&"<br>")
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)&"<br>")
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)&"<br>")
Seta=nothing
rs.close
Setrs=nothing
%>
使用cdonts,可以发送、查看邮件,实现webmail的功能。结合wsh,可以实现对nt主机的管理,如nt用户管理、iis虚拟主机设置、exchange邮箱设置等等,就像管理本地机一样方便。
愤怒的大鸟 该用户已被删除
沙发
发表于 2015-1-18 18:51:46 | 只看该作者
它可通过内置的组件实现更强大的功能,如使用A-DO可以轻松地访问数据库。
飘飘悠悠 该用户已被删除
板凳
发表于 2015-1-23 05:48:28 | 只看该作者
代码逻辑混乱,难于管理:由于ASP是脚本语言混合html编程,所以你很难看清代码的逻辑关系,并且随着程序的复杂性增加,使得代码的管理十分困难,甚至超出一个程序员所能达到的管理能力,从而造成出错或这样那样的问题。
分手快乐 该用户已被删除
地板
发表于 2015-1-31 15:23:27 | 只看该作者
我想问如何掌握学习节奏(先学什么再学什么)最好详细点?
因胸联盟 该用户已被删除
5#
发表于 2015-2-6 20:14:13 | 只看该作者
他的语法和设计思路和VB完全相同,导致很多ASP的书都留一句“相关内容请参考VB的相关教材....”更糟糕的是,相当多的ASP教程混合了Javascript,VBscript等等脚本语言,搞的初学者。
第二个灵魂 该用户已被删除
6#
发表于 2015-2-18 13:24:08 | 只看该作者
ASP主要是用好六个对象,其实最主要的是用好其中两个:response和request,就可以随心所欲地控制网页变换和响应用户动作了。
只想知道 该用户已被删除
7#
发表于 2015-3-6 07:43:56 | 只看该作者
没有坚实的理论做基础,那么我们连踏入社会第一步的资本都没有,特别对于计算机专业的学生学好专业知识是置关重要的。在这里我侧重讲一下如何学习ASP,从平时的学习过程中。
蒙在股里 该用户已被删除
8#
发表于 2015-3-12 22:54:33 | 只看该作者
ASP.Net摆脱了以前ASP使用脚本语言来编程的缺点,理论上可以使用任何编程语言包括C++,VB,JS等等,当然,最合适的编程语言还是MS为.NetFrmaework专门推出的C(读csharp),它可以看作是VC和Java的混合体吧。
再见西城 该用户已被删除
9#
发表于 2015-3-20 05:10:15 | 只看该作者
他的语法和设计思路和VB完全相同,导致很多ASP的书都留一句“相关内容请参考VB的相关教材....”更糟糕的是,相当多的ASP教程混合了Javascript,VBscript等等脚本语言,搞的初学者。
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|仓酷云 鄂ICP备14007578号-2

GMT+8, 2024-12-23 05:06

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表