ASP生成Excel表格(调试通过)

最新推荐文章于 2021-03-18 07:07:55 发布

ITFLY8

最新推荐文章于 2021-03-18 07:07:55 发布

阅读量2.8k

点赞数

分类专栏： ASP技术文章标签： excel asp vbscript class function each

本文链接：https://blog.csdn.net/ITFLY8/article/details/577442

版权

ASP技术专栏收录该内容

48 篇文章 0 订阅

订阅专栏

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>ASP生成Excel表格演示</title>
</head>

<%'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
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 * FROM xxxx", "Provider=SQLOLEDB.1;Persist SecurityInfo=True;User ID=;Password=;Initial Catalog=xxxx;Data source=excel.mdb;"
sql="select id,hotel from lei_hotel"
objrs.open sql,conn,1,3
Dim SaveName
'SaveName = Request.Cookies("savename")("name")
SaveName ="nihao"
Dim objExcel
Dim ExcelPath
'ExcelPath = "Excel/" & SaveName & ".xls"
ExcelPath =SaveName & ".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文件.
Response.Write("生成Excel表格成功")
Else
Response.Write "在保存过程中有错误!"
End If
Set objExcel = Nothing
objRS.Close
Set objRS = Nothing
%>
<body>
</body>
</html>