asp操作Excel类_.docx

《asp操作Excel类_.docx》由会员分享，可在线阅读，更多相关《asp操作Excel类_.docx（28页珍藏版）》请在三一文库上搜索。

1、asp操作Excel类_ asp操作Excel类： % * 用法说明 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 Selec

2、t 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组件的操作权限。在指

3、令行键入“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 设置标题

4、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 3

5、1333716 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() Exc

6、elApp.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

7、) 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 P

8、roperty 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

9、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 i

10、f 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(SheetNam

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

12、维度应当为二) 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

13、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(E

14、xcelData, -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 Spr

15、eadsheet = 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 = ExcelB

16、ook.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_ = getCo

17、lName(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 合并单元格(单

18、元区域) .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

19、 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 Spread

20、sheet.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 i

21、f 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_ =

22、 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

23、 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 GetArr

24、ayDim(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 Ca

25、se DataType Case Currency: GetNumFormatLocal = ￥#,#0.00_);(￥#,#0.00) Case Time: GetNumFormatLocal = $-F800dddd, mmmm dd, yyyy Case Char: GetNumFormatLocal = Case Common: GetNumFormatLocal = G/通用格式 Case Number: GetNumFormatLocal = #,#0.00_ Case else : GetNumFormatLocal = End Select End Function Publi

26、c 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 colN

27、um_ - 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

28、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_) = R

29、sFlied(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 te

30、mpFirstLine_, 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 Pr

31、eserve 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) = tempShee

32、tTitle_ 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 AddtD

33、ata(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 Sheet

34、Name_(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

35、 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 m

36、sec_ = (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_ T

37、o 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

38、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, Sys

39、temStr (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

40、.xls a.SavePath=xx-1.xls a.AddtData e, Sheet1 a.Create() response.Write(生成 a.SavePath 用法了 a.GetTime(a.UsedTime) ) 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

41、) ) 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) ) Set a=nothing 用法示例三 生成两个表 Set a=new CreateExcel a.SavePath=z.xls a.SheetName=array(工作簿名称一,工作簿名称二) a.