导出Excel报表的类

导出Excel报表的类2009-12-15 leadbbs 一千零一个愿望类文件Excel.asp
<%
""/**************************************/
""/* written by yzcangel                */
""/* version : v1.0                     */
""/* createdata:2005-09-01                   */
""/* lastmodifydate:2005-09-01          */
""/* Eamil:yzcangel@sohu.com            */
""/* QQ:80214600                        */
""/**************************************/
""类开始
Class Cls_Excel
    ""声明常量、变量
    Private objRs
    Private objExcelApp
    Private objExcelBook
    Private Conn
    Private Sql
    Private Title
    Private FieldName
    Private FieldValue
    Private FilePath
    Private FileName
    Private Col
    Private Row
    ""Class_Initialize 类的初始化
    Private Sub Class_Initialize（）
          Row = 1 ""设定生成的Excel默认起始行
          Col = 1 ""设定生成的Excel默认起始列
    End Sub
    ""ReportConn得到数据库连接对象
    Public Property Let ReportConn（ByVal objConn）
          Set Conn = objConn
    End Property
    ""ReportSql得到SQL字符串
    Public Property Let ReportSql（ByVal strSql）
          Sql = strSql
    End Property
    ""ReportTitle得到所要生成报表的标题
    Public Property Let ReportTitle（ByVal strTitle）
          Title = strTitle
    End Property
    ""RsFieldName得到所要生成报表的列名称
    Public Property Let RsFieldName（ByVal strName）
          FieldName = Split（strName,""）
    End Property
    ""RsFieldValue得到所要生成报表的列值的数据库标识字段
    Public Property Let RsFieldValue（ByVal strValue）
          FieldValue = Split（strValue,""）
    End Property
    ""SaveFilePath得到Excel报表的保存路径
    Public Property Let SaveFilePath（ByVal strFilePath）
          FilePath = strFilePath
    End Property
    ""SaveFileName得到Excel报表的保存文件名
    Public Property Let SaveFileName（ByVal strFileName）
          FileName = strFileName
    End Property
    ""ColumnOffset得到Excel报表默认起始列
    Public Property Let ColumnOffset（ByVal ColOff）
          If ColOff > 0 then
                Col = ColOff
          Else
                Col = 1
          End If
    End Property
    ""RowOffset得到Excel报表默认起始行
    Public Property Let RowOffset（ByVal RowOff）
          If RowOff > 0 then
                Row = RowOff
          Else
                Row = 1
          End If
    End Property
    ""生成报表
    Sub Worksheet（）
          Dim iCol,iRow,Num
          iCol = Col
          iRow = Row
          Num = 1
          Call DBRs（）
          Call ExcelApp（）
          Set objExcelBook = objExcelApp.Workbooks.Add
          ""写Excel标题
          ""--------------------------------------------------------
          objExcelBook.WorkSheets（1）.Cells（iRow,iCol）.Value = Title
          ""--------------------------------------------------------
          ""写Excel各列名
          ""--------------------------------------------------------
          iRow = Row + 1
          objExcelBook.WorkSheets（1）.Cells（iRow,iCol）.Value = "序号"
          iCol = iCol + 1
          For i = 0 to Ubound（FieldName）
                objExcelBook.WorkSheets（1）.Cells（iRow,iCol）.Value = FieldName（i）
                iCol = iCol + 1
          Next
          ""--------------------------------------------------------
          ""写Excel各列值
          ""--------------------------------------------------------
          iRow = Row + 2
          Do While Not objRS.EOF
                iCol = Col
                objExcelBook.WorkSheets（1）.Cells（iRow,iCol）.Value = Num
                iCol = iCol + 1
                For i = 0 to Ubound（FieldValue）
                      If IsNull（objRS（FieldValue（i））） then
                            objExcelBook.WorkSheets（1）.Cells（iRow,iCol）.Value = ""
                      Else
                            objExcelBook.WorkSheets（1）.Cells（iRow,iCol）.Value = objRS（FieldValue（i））
                      End If
                      iCol = iCol + 1
                Next
                objRS.MoveNext
                iRow = iRow + 1
                Num = Num + 1
          Loop
          ""--------------------------------------------------------
          Call SaveWorksheet（）
    End Sub
    ""创建Adodb.Recordset对象
    Sub DBRs（）
          If IsObject（objRs） = True Then Exit Sub
          Set objRs = Server.CreateObject（"Adodb.Recordset"）
          objRs.Open Sql,Conn,1,1
          If Err.Number > 0 Then
                Response.End
          End If
    End Sub
    ""创建Excel.Application对象
    Sub ExcelApp（）
          If IsObject（objExcelApp） = True Then Exit Sub
          Set objExcelApp = Server.CreateObject（"Excel.Application"）
          objExcelApp.Application.Visible = True
          If Err.Number > 0 Then
                Response.End
          End If
    End Sub
    ""保存Excel报表
    Sub SaveWorksheet（）
          objExcelbook.SaveAs FilePath & FileName & ".xls"
          If Err.Number = 0 Then
                Call Message（"导出数据成功！"）
          Else
                Call Message（"导出数据失败！"）
          End If
    End Sub
    ""信息提示
    Sub Message（msg）
          Response.Write（"<script language=""JavaScript"">"）
          Response.Write（"alert（"""&msg&"""）;"）
          Response.Write（"</script>"）
          Response.End
    End Sub
    ""Class_Terminate 类注销
    Private Sub Class_Terminate（）
          objExcelApp.Application.Quit
          Set objExcelBook = Nothing
          Set objExcelApp = Nothing
          objRs.Close
          Set objRs = Nothing
    End Sub
""类结束
End Class
%>