生成Excel的” 源代码
给你一个能“ 生成Excel的” 源代码 具体怎样操作 你自己办了
'Option Explicit
Class ExcelGen
Private objSpreadsheet
Private iColOffset
Private iRowOffset
Sub Class_Initialize()
Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet")
iRowOffset = 2
iColOffset = 2
End Sub
Sub Class_Terminate()
Set objSpreadsheet = Nothing 'Clean up
End Sub
Public Property Let ColumnOffset(iColOff)
If iColOff>0 then
iColOffset = iColOff
Else
iColOffset = 2
End If
End Property
Public Property Let RowOffset(iRowOff)
If iRowOff > 0 then
iRowOffset = iRowOff
Else
iRowOffset = 2
End If
End Property
Sub GenerateWorksheet(objRS) 'Populates the Excel worksheet based on a Recordset 's contents
'Start by displaying the titles
If objRS.EOF then
Exit Sub
end if
Dim objField, iCol, iRow
iCol = iColOffset
iRow = iRowOffset
For Each objField in objRS.Fields
objSpreadsheet.Cells(iRow, iCol).Value = objField.Name
objSpreadsheet.Columns(iCol).AutoFitColumns '设置Excel表里的字体
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中
iCol = iCol + 1
Next 'objField
'Display all of the data
Do While Not objRS.EOF
iRow = iRow + 1
iCol = iColOffset
For Each objField in objRS.Fields
If IsNull(objField.Value) then
objSpreadsheet.Cells(iRow,iCol).Value = ""
Else
objSpreadsheet.Cells(iRow, iCol).Value = objField.Value
objSpreadsheet.Columns(iCol).AutoFitColumns
objSpreadsheet.Cells(iRow,iCol).Font.Bold = False
objSpreadsheet.Cells(iRow,iCol).Font.Italic = False
objSpreadsheet.Cells(iRow,iCol).Font.Size = 10
End If
iCol = iCol + 1
Next 'objField
objRS.MoveNext
Loop
End Sub
Function SaveWorksheet(strFileName) 'Save the worksheet to a specified filename
On Error Resume Next
Call objSpreadsheet.ActiveSheet.Export(strFileName, 0)
SaveWorksheet = (Err.Number = 0)
End Function
End Class
Dim objRS
Set objRS = Server.CreateObject("ADODB.Recordset")
objRS.Open "SELECT btel as 号码 FROM bmember", "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Password=;Initial Catalog=7056a;Data source=127.0.0.1;"
Dim SaveName
SaveName = Request.Cookies("savename")("name")
Dim objExcel
Dim ExcelPath
ExcelPath = "Excel/gg.xls"
Set objExcel = New ExcelGen
objExcel.RowOffset = 1
objExcel.ColumnOffset = 1
objExcel.GenerateWorksheet(objRS)
If objExcel.SaveWorksheet(Server.MapPath(ExcelPath)) then
Response.Write "<html><body bgcolor='gainsboro' text='#000000'>已保存为Excel文件. <a href="&server.URLEncode(ExcelPath)&">下载</a>"
Else
Response.Write "在保存过程中有错误!"
End If
Set objExcel = Nothing
objRS.Close
Set objRS = Nothing