ASP实例代码:asp操作Excel类
发布时间:2019-04-13浏览次数:986
<p>
</p>
<table style="BORDER-RIGHT: #cccccc 1px dotted; TABLE-LAYOUT: fixed; BORDER-TOP: #cccccc 1px dotted; BORDER-LEFT: #cccccc 1px dotted; BORDER-BOTTOM: #cccccc 1px dotted" cellspacing="0" cellpadding="6" width="95%" align="center" border="0"><tbody><tr>
<td style="WORD-WRAP: break-word" bgcolor="#fdfddf">
<font color="#ff0000">WebjxCom提示:</font><font color="#000000">ASP实例代码:asp操作Excel类.</font>
</td>
</tr></tbody></table>
<p><strong>asp操作Excel类</strong>:</p>
<p><span class="code"><%<br>'*******************************************************************<br>'使用说明<br>'Dim a<br>'Set a=new CreateExcel<br>'a.SavePath="x" '保存路径<br>'a.SheetName="工作簿名称"       '多个工作表 a.SheetName=array("工作簿名称一","工作簿名称二")<br>'a.SheetTitle="表名称"         '可以为空  多个工作表 a.SheetName=array("表名称一","表名称二")<br>'a.Data =d '二维数组             '多个工作表 array(b,c) b与c为二维数组<br>'Dim rs<br>'Set rs=server.CreateObject("Adodb.RecordSet")<br>'rs.open "Select id, classid, className from [class] ",conn, 1, 1<br>'a.AddDBData rs, "字段名一,字段名二", "工作簿名称", "表名称",     true    'true自动获取表字段名<br>'a.AddData c, true , "工作簿名称", "表名称"    'c二维数组          true  第一行是否为标题行<br>'a.AddtData e, "Sheet1"   '按模板生成  c=array(array("AA1", "内容"), array("AA2", "内容2"))<br>'a.Create()<br>'a.UsedTime        生成时间,毫秒数<br>'a.SavePath        保存路径<br>'Set a=nothing<br>'设置COM组件的操作权限。在命令行键入“DCOMCNFG”,则进入COM组件配置界面,选择MicrosoftExcel后点击属性按钮,将三个单选项一律选择自定义,编辑中将Everyone加入所有权限<br>'*******************************************************************<br>Class CreateExcel <br>    Private CreateType_<br>    Private savePath_<br>    Private readPath_<br>    Private AuthorStr              Rem 设置作者<br>    Private VersionStr          Rem 设置版本<br>    Private SystemStr              Rem 设置系统名称<br>    Private SheetName_             Rem 设置表名<br>    Private SheetTitle_         Rem 设置标题<br>    Private ExcelData             Rem 设置表数据<br>    Private ExcelApp             Rem Excel.Application<br>    Private ExcelBook<br>    Private ExcelSheets<br>    Private UsedTime_            Rem 使用的时间<br>    Public TitleFirstLine        Rem 首行是否标题<br>    Private Sub Class_Initialize()<br>        Server.ScriptTimeOut = 99999<br>        UsedTime_ = Timer<br>        SystemStr            =    "Lc00_CreateExcelServer"<br>        AuthorStr            =    "Surnfu  surnfu@126.com  31333716"<br>        VersionStr            =    "1.0"<br>        if not IsObjInstalled("Excel.Application") then<br>            InErr("服务器未安装Excel.Application控件")<br>        end if<br>        set ExcelApp = createObject("Excel.Application")<br>        ExcelApp.DisplayAlerts = false<br>        ExcelApp.Application.Visible = false<br>        CreateType_ = 1<br>        readPath_ = null<br>    End Sub <br><br>    Private Sub Class_Terminate()<br>        ExcelApp.Quit<br>        If Isobject(ExcelSheets)     Then Set ExcelSheets    =    Nothing<br>        If Isobject(ExcelBook)         Then Set ExcelBook        =    Nothing<br>        If Isobject(ExcelApp)         Then Set ExcelApp        =    Nothing<br>    End Sub <br><br>    Public Property Let ReadPath(ByVal Val)<br>        If Instr(Val, ":\")<>0 Then<br>            readPath_ = Trim(Val)<br>        else<br>            readPath_=Server.MapPath(Trim(Val))<br>        end if<br>    End Property<br><br>    Public Property Let SavePath(ByVal Val)<br>        If Instr(Val, ":\")<>0 Then<br>            savePath_ = Trim(Val)<br>        else<br>            savePath_=Server.MapPath(Trim(Val))<br>        end if<br>    End Property<br>    <br>    <br>    Public Property Let CreateType(ByVal Val)<br>        if Val <> 1 and Val <> 2 then<br>            CreateType_ = 1<br>        else<br>            CreateType_ = Val<br>        end if    <br>    End Property<br>    <br>    Public Property Let Data(ByVal Val)<br>        if not isArray(Val) then<br>            InErr("表数据设置有误")<br>        end if<br>          ExcelData = Val<br>    End Property<br>    Public Property Get SavePath()<br>    SavePath = savePath_<br>    End Property<br>    Public Property Get UsedTime()<br>          UsedTime = UsedTime_<br>    End Property<br>    Public Property Let SheetName(ByVal Val)<br>        if not isArray(Val) then<br>            if Val = "" then<br>                InErr("表名设置有误")<br>            end if<br>            TitleFirstLine = true<br>        else<br>            ReDim TitleFirstLine(Ubound(Val))<br>            Dim ik_<br>            For ik_ = 0 to Ubound(Val)<br>                TitleFirstLine(ik_) = true<br>            Next<br>        end if<br>          SheetName_ = Val<br>    End Property<br>    <br>    Public Property Let SheetTitle(ByVal Val)<br>        if not isArray(Val) then<br>            if Val = "" then<br>                InErr("表标题设置有误")<br>            end if<br>        end if<br>          SheetTitle_ = Val<br>    End Property<br>    <br>    Rem 检查数据<br>    Private Sub CheckData()<br>        if savePath_ = "" then InErr("保存路径不能为空")<br>        if not isArray(SheetName_) then<br>            if SheetName_ = "" then InErr("表名不能为空")<br>        end if<br>        <br>        if CreateType_ = 2 then<br>            if not isArray(ExcelData) then<br>                InErr("数据载入错误,或者未载入")<br>            end if<br>            Exit Sub<br>        end if<br>        <br>        if isArray(SheetName_) then<br>            if not isArray(SheetTitle_) then<br>                if SheetTitle_ <> "" then InErr("表标题设置有误,与表名不对应")<br>            end if<br>        end if<br>        if not IsArray(ExcelData) then<br>            InErr("表数据载入有误")<br>        end if<br>        if isArray(SheetName_) then<br>            if GetArrayDim(ExcelData) <> 1 then InErr("表数据载入有误,数据格式错误,维度应该为一")<br>        else<br>            if GetArrayDim(ExcelData) <> 2 then InErr("表数据载入有误,数据格式错误,维度应该为二")<br>        end if<br>    End Sub<br>    Rem 生成Excel<br>    Public Function Create()<br>        Call CheckData()<br>        if not isnull(readPath_) then<br>            ExcelApp.WorkBooks.Open(readPath_) <br>        else<br>            ExcelApp.WorkBooks.add<br>        end if<br>        <br>        set ExcelBook = ExcelApp.ActiveWorkBook<br>        set ExcelSheets = ExcelBook.Worksheets<br>        <br>        if CreateType_ = 2 then<br>            Dim ih_<br>            For ih_ = 0 to Ubound(ExcelData)<br>                Call SetSheets(ExcelData(ih_), ih_)<br>            Next<br>            ExcelBook.SaveAs savePath_<br>            UsedTime_ = FormatNumber((Timer - UsedTime_)*1000, 3)<br>            Exit Function<br>        end if<br>        <br>        if IsArray(SheetName_) then<br>            Dim ik_<br>            For ik_ = 0 to Ubound(ExcelData)<br>                Call CreateSheets(ExcelData(ik_), ik_)<br>            Next<br>        else<br>            Call CreateSheets(ExcelData, -1)<br>        end if<br>        <br>        ExcelBook.SaveAs savePath_<br>        UsedTime_ = FormatNumber((Timer - UsedTime_)*1000, 3)<br>    End Function <br>    Private Sub CreateSheets(ByVal Data_, DataId_)<br>        Dim Spreadsheet<br>        Dim tempSheetTitle<br>        Dim tempTitleFirstLine<br>        if DataId_<>-1 then<br>            if DataId_ > ExcelSheets.Count - 1 then<br>                ExcelSheets.Add()<br>                set Spreadsheet = ExcelBook.Sheets(1)<br>            else<br>                set Spreadsheet = ExcelBook.Sheets(DataId_ + 1)<br>            end if<br>            if isArray(SheetTitle_) then<br>                tempSheetTitle = SheetTitle_(DataId_)<br>            else<br>                tempSheetTitle = ""<br>            end if<br>            tempTitleFirstLine = TitleFirstLine(DataId_)<br>            Spreadsheet.Name = SheetName_(DataId_)<br>        else<br>            set Spreadsheet = ExcelBook.Sheets(1)<br>            Spreadsheet.Name = SheetName_<br>            tempSheetTitle = SheetTitle_<br>            tempTitleFirstLine = TitleFirstLine<br>        end if<br>        Dim Line_ : Line_ = 1<br>        Dim RowNum_ : RowNum_ = Ubound(Data_, 1) + 1<br>        Dim LastCols_<br>        if tempSheetTitle <> "" then<br>            'Spreadsheet.Columns(1).ShrinkToFit=true '设定是否自动适应表格单元大小(单元格宽不变)<br>            LastCols_ = getColName(Ubound(Data_, 2) + 1)<br>            with Spreadsheet.Cells(1, 1)<br>                .value = tempSheetTitle<br>                '设置Excel表里的字体 <br>                .Font.Bold = True '单元格字体加粗<br>                .Font.Italic = False '单元格字体倾斜<br>                .Font.Size = 20 '设置单元格字号<br>                .font.name="宋体" '设置单元格字体<br>                '.font.ColorIndex=2 '设置单元格文字的颜色,颜色可以查询,2为白色<br>            End with<br>            with Spreadsheet.Range("A1:"& LastCols_ &"1")<br>                .merge '合并单元格(单元区域)<br>                '.Interior.ColorIndex = 1 '设计单元络背景色<br>                .HorizontalAlignment = 3 '居中<br>            End with<br>            Line_ = 2<br>            RowNum_ = RowNum_ + 1<br>        end if<br>        Dim iRow_, iCol_<br>        Dim dRow_, dCol_<br>        Dim tempLastRange : tempLastRange = getColName(Ubound(Data_, 2)+1) & (RowNum_)<br>        <br>        Dim BeginRow : BeginRow = 1<br>        if tempSheetTitle <> "" then BeginRow = BeginRow + 1<br>        if tempTitleFirstLine = true then BeginRow = BeginRow + 1<br>        <br>        if BeginRow=1 then<br>            with Spreadsheet.Range("A1:"& tempLastRange)<br>                .Borders.LineStyle = 1<br>                .BorderAround -4119, -4138 '设置外框<br>                .NumberFormatLocal = "@"   '文本格式<br>                .Font.Bold = False <br>                .Font.Italic = False <br>                .Font.Size = 10<br>                .ShrinkToFit=true <br>            end with<br>        else<br>            with Spreadsheet.Range("A1:"& tempLastRange)<br>                .Borders.LineStyle = 1<br>                .BorderAround -4119, -4138<br>                .ShrinkToFit=true <br>            end with<br>            <br>            with Spreadsheet.Range("A"& BeginRow &":"& tempLastRange)<br>                .NumberFormatLocal = "@" <br>                .Font.Bold = False <br>                .Font.Italic = False <br>                .Font.Size = 10<br>            end with<br>        end if<br>        <br>        if tempTitleFirstLine = true then<br>            BeginRow = 1<br>            if tempSheetTitle <> "" then BeginRow = BeginRow + 1<br>        <br>            with Spreadsheet.Range("A"& BeginRow &":"& getColName(Ubound(Data_, 2)+1) & (BeginRow))<br>                .NumberFormatLocal = "@"<br>                .Font.Bold = True <br>                .Font.Italic = False <br>                .Font.Size = 12<br>                .Interior.ColorIndex = 37<br>                .HorizontalAlignment = 3 '居中<br>                .font.ColorIndex=2<br>            end with<br>        end if<br>        <br>        For iRow_ = Line_ To RowNum_<br>            For iCol_ = 1 To (Ubound(Data_, 2) + 1)<br>                dCol_ = iCol_ - 1<br>                if tempSheetTitle <> "" then dRow_ = iRow_ - 2 else dRow_ = iRow_ - 1<br>                If not IsNull(Data_(dRow_, dCol_)) then <br>                    with Spreadsheet.Cells(iRow_, iCol_)<br>                        .Value = Data_(dRow_, dCol_)<br>                    End with<br>                End If <br>            Next<br>        Next<br>        set Spreadsheet = Nothing<br>    End Sub <br>    Rem 测试组件是否已经安装<br>    Private Function IsObjInstalled(strClassString)<br>        On Error Resume Next<br>        IsObjInstalled = False<br>        Err = 0<br>        Dim xTestObj<br>        Set xTestObj = Server.CreateObject(strClassString)<br>        If 0 = Err Then IsObjInstalled = True<br>        Set xTestObj = Nothing<br>        Err = 0<br>    End Function<br>    Rem 取得数组维数<br>    Private Function GetArrayDim(ByVal arr)   <br>        GetArrayDim = Null   <br>        Dim i_, temp   <br>        If IsArray(arr) Then  <br>            For i_ = 1 To 60   <br>                On Error Resume Next  <br>                temp = UBound(arr, i_)   <br>                If Err.Number <> 0 Then  <br>                    GetArrayDim = i_ - 1<br>                    Err.Clear <br>                    Exit Function  <br>                End If  <br>            Next  <br>            GetArrayDim = i_   <br>        End If  <br>    End Function <br>    Private Function GetNumFormatLocal(DataType)<br>        Select Case DataType<br>            Case "Currency":<br>                GetNumFormatLocal = "¥#,##0.00_);(¥#,##0.00)"<br>            Case "Time":<br>                GetNumFormatLocal = "[$-F800]dddd, mmmm dd, yyyy"<br>            Case "Char":<br>                GetNumFormatLocal = "@"<br>            Case "Common":<br>                GetNumFormatLocal = "G/通用格式"<br>            Case "Number":<br>                GetNumFormatLocal = "#,##0.00_"<br>            Case else :<br>                GetNumFormatLocal = "@"<br>        End Select<br>    End Function<br>    Public Sub AddDBData(ByVal RsFlied, ByVal FliedTitle, ByVal tempSheetName_, ByVal tempSheetTitle_, DBTitle)<br>        if RsFlied.Eof then Exit Sub<br>        Dim colNum_ : colNum_ = RsFlied.fields.count<br>        Dim Rownum_ : Rownum_ = RsFlied.RecordCount<br>        Dim ArrFliedTitle<br>        <br>        if DBTitle = true then<br>            FliedTitle = ""<br>            Dim ig_<br>            For ig_=0 to colNum_ - 1<br>                FliedTitle = FliedTitle & RsFlied.fields.item(ig_).name<br>                if ig_ <> colNum_ - 1 then FliedTitle = FliedTitle &","<br>            Next<br>        end if<br>        <br>        if FliedTitle<>"" then<br>            Rownum_ = Rownum_ + 1<br>            ArrFliedTitle = Split(FliedTitle, ",")<br>            if Ubound(ArrFliedTitle) <> colNum_ - 1  then<br>                InErr("获取数据库表有误,列数不符")<br>            end if<br>        end if    <br>        Dim tempData : ReDim tempData(Rownum_ - 1, colNum_ - 1)<br>        <br>        Dim ix_, iy_<br>        Dim iz<br>        if FliedTitle<>"" then iz = Rownum_ - 2  else iz = Rownum_ - 1<br>        <br>        For ix_ = 0 To iz<br>            For iy_ = 0 To colNum_ - 1<br>                if FliedTitle<>"" then<br>                    if ix_=0 then<br>                        tempData(ix_, iy_) = ArrFliedTitle(iy_)<br>                        tempData(ix_ + 1, iy_) = RsFlied(iy_)<br>                    else<br>                        tempData(ix_ + 1, iy_) = RsFlied(iy_)<br>                    end if<br>                else<br>                    tempData(ix_, iy_) = RsFlied(iy_)<br>                end if<br>            Next<br>            RsFlied.MoveNext<br>        Next<br>        <br>        Dim tempFirstLine <br>        if FliedTitle<>"" then tempFirstLine = true else tempFirstLine = false<br>        Call AddData(tempData, tempFirstLine, tempSheetName_, tempSheetTitle_)<br>    End Sub<br>    Public Sub AddData(ByVal tempDate_, ByVal tempFirstLine_, ByVal tempSheetName_, ByVal tempSheetTitle_)<br>        if not isArray(ExcelData) then<br>            ExcelData = tempDate_<br>            TitleFirstLine = tempFirstLine_<br>            SheetName_ = tempSheetName_<br>            SheetTitle_ = tempSheetTitle_<br>        else<br>            if GetArrayDim(ExcelData) = 1 then<br>                Dim tempArrLen : tempArrLen = Ubound(ExcelData)+1<br>                ReDim Preserve ExcelData(tempArrLen)<br>                ExcelData(tempArrLen) = tempDate_<br>                ReDim Preserve TitleFirstLine(tempArrLen)<br>                TitleFirstLine(tempArrLen) = tempFirstLine_<br>                ReDim Preserve SheetName_(tempArrLen)<br>                SheetName_(tempArrLen) = tempSheetName_<br>                ReDim Preserve SheetTitle_(tempArrLen)<br>                SheetTitle_(tempArrLen) = tempSheetTitle_<br>            else<br>                Dim tempOldData : tempOldData = ExcelData<br>                ExcelData = Array(tempOldData, tempDate_)<br>                TitleFirstLine = Array(TitleFirstLine, tempFirstLine_)<br>                SheetName_ = Array(SheetName_, tempSheetName_)<br>                SheetTitle_ = Array(SheetTitle_, tempSheetTitle_)<br>            end if<br>        end if<br>    End Sub<br>    Rem 模板增加数据方法<br>    Public Sub AddtData(ByVal tempDate_, ByVal tempSheetName_)<br>        CreateType_ = 2<br>        if not isArray(ExcelData) then<br>            ExcelData = Array(tempDate_)<br>            SheetName_ = Array(tempSheetName_)<br>        else<br>            Dim tempArrLen : tempArrLen = Ubound(ExcelData)+1<br>            ReDim Preserve ExcelData(tempArrLen)<br>            ExcelData(tempArrLen) = tempDate_<br>            ReDim Preserve SheetName_(tempArrLen)<br>            SheetName_(tempArrLen) = tempSheetName_<br>        End if<br>    End Sub<br>    Private Sub SetSheets(ByVal Data_, DataId_)<br>        Dim Spreadsheet<br>        set Spreadsheet = ExcelBook.Sheets(SheetName_(DataId_))<br>        Spreadsheet.Activate<br>        Dim ix_<br>        For ix_ =0 To Ubound(Data_)<br>            if not isArray(Data_(ix_)) then InErr("表数据载入有误,数据格式错误")<br>            if Ubound(Data_(ix_)) <> 1 then InErr("表数据载入有误,数据格式错误")<br>            Spreadsheet.Range(Data_(ix_)(0)).value = Data_(ix_)(1)<br>        Next<br>        set Spreadsheet = Nothing<br>    End Sub<br>    Public Function GetTime(msec_)<br>        Dim ReTime_ : ReTime_=""<br>        if msec_ < 1000 then<br>            ReTime_ = msec_ &"MS"<br>        else<br>            Dim second_<br>            second_ = (msec_ \ 1000)<br>            if (msec_ mod 1000)<>0 then<br>                msec_ = (msec_ mod 1000) &"毫秒"<br>            else<br>                msec_ = ""<br>            end if<br>            Dim n_, aryTime(2), aryTimeunit(2)<br>