📄 execl类.asp

📁 这是去年开发的中移鼎讯手机进销存系统大家
💻 ASP
字号:
<%
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(objRS1) 
		'Populates the Excel worksheet based on a Recordset's contents 
		'Start by displaying the titles 
		If objRS1.EOF then Exit Sub 
		Dim objField, iCol, iRow 
		iCol = iColOffset 
		iRow = iRowOffset 
		
		For N=0 To TempnLen	 
			objSpreadsheet.Cells(iRow, iCol).Value = transColumns(aryColumns(N)) 
			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 + -