📄 10.asp

📁 这是去年开发的中移鼎讯手机进销存系统大家
💻 ASP
字号:
<%
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 
'--控制Excel表头
	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 T_User", "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Password=666;Initial Catalog=Mobile_Sale;Data source=(local);"
Dim SaveName
SaveName = Request.Cookies("savename")("name")
Dim objExcel
Dim ExcelPath
'ExcelPath = "Excel\" & SaveName & ".xls"
ExcelPath = "Excel\22.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
%>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -