stat_to_xls.asp

关于设备管理的大型系统

<!--#include file="user_timeout.asp"-->
<!--#include file="getabcd.asp"-->
<%
query_time=request("query_time")
taxis=request("taxis")
if query_time="" then
	query_time=year(now())
end if
if taxis="" then
	taxis="zheng"
end if
if query_time="全部" then
	if taxis="zheng" then
		sql="select * from contract order by c_no"
	else
		sql="select * from contract order by c_no desc"
	end if
else
	if taxis="zheng" then
		sql="select * from contract where create_time between #"&query_time&"-1-1 00:00:00# and #"&query_time&"-12-31 23:59:59# order by c_no"
	else
		sql="select * from contract where create_time between #"&query_time&"-1-1 00:00:00# and #"&query_time&"-12-31 23:59:59# order by c_no desc"
	end if
end if
'response.write sql
rs.open sql,conn,1,1

Set xlApplication = Server.CreateObject("Excel.Application") '调用excel对象
xlApplication.Visible = False '无需打开excel
xlApplication.SheetsInNewWorkbook=1 '指定excel中表的数量
xlApplication.Workbooks.Add '添加工作簿
Set xlWorksheet = xlApplication.Worksheets(1) '生成第1个工作表的子对象
xlWorksheet.name="设备合同统计表" '指定工作表名称
'指定列的宽度以及对齐方式
xlApplication.ActiveSheet.Columns(1).ColumnWidth=20 
xlApplication.ActiveSheet.Columns(1).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(2).ColumnWidth=10
xlApplication.ActiveSheet.Columns(2).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(3).ColumnWidth=65
xlApplication.ActiveSheet.Columns(3).HorizontalAlignment=3
xlApplication.ActiveSheet.Columns(4).ColumnWidth=20
xlApplication.ActiveSheet.Columns(4).HorizontalAlignment=3
'xlApplication.ActiveSheet.Rows(i).RowHeight = 30'行的高度
'指定列的高度以及特定列
xlWorksheet.Range(xlWorksheet.Cells(1,1), xlWorksheet.Cells(1,4)).MergeCells =True '合并列
xlWorksheet.Range("A1").value="北华航天工业学院 "&query_time&"年设备合同情况统计"
xlWorksheet.Range("A1").font.Size=16'字体大小
xlWorksheet.Range("A1").font.bold=true'粗体
xlWorksheet.Range("A1").HorizontalAlignment=3'水平对齐
xlWorksheet.Range("A1").VerticalAlignment=3'垂直对齐
xlWorksheet.Range("A2:D6").Borders.LineStyle=1
xlWorksheet.Cells(2,1).Value = ""
xlWorksheet.Cells(2,2).Value = "项目数"
xlWorksheet.Cells(2,3).Value = "金额"
xlWorksheet.Cells(2,4).Value = "比例"
stat_all_num=0
stat_all_pay=0.00
stat_unpay_num=0
stat_unpay_pay=0.00
stat_fpay_num=0
stat_fpay_pay=0.00
stat_f_payed=0.00'已支付的首款总额
stat_l_unpay=0.00'未支付的尾款总额
stat_lpay_num=0
stat_lpay_pay=0.00
for i=1 to rs.recordcount
	stat_all_num=stat_all_num+1
	stat_all_pay=stat_all_pay+rs("c_total")
	if rs("c_state")="new" or rs("c_state")="audited" then
		stat_unpay_num=stat_unpay_num+1
		stat_unpay_pay=stat_unpay_pay+rs("c_total")
	elseif rs("c_state")="f_passed" then
		stat_fpay_num=stat_fpay_num+1
		stat_fpay_pay=stat_fpay_pay+rs("c_total")
		stat_f_payed=stat_f_payed+rs("first_payment")
		stat_l_unpay=stat_l_unpay+rs("last_payment")
	else
		stat_lpay_num=stat_lpay_num+1
		stat_lpay_pay=stat_lpay_pay+rs("c_total")
	end if
	rs.movenext
next
call DBConnEnd()
xlWorksheet.Cells(3,1).Value = "全部项目"
xlWorksheet.Cells(3,2).Value = stat_all_num
xlWorksheet.Cells(3,3).Value = FormatCurrency(stat_all_pay)
xlWorksheet.Cells(3,4).Value = "——"
xlWorksheet.Cells(4,1).Value = "已完成项目"
xlWorksheet.Cells(4,2).Value = stat_lpay_num
xlWorksheet.Cells(4,3).Value = FormatCurrency(stat_lpay_pay)
xlWorksheet.Cells(4,4).Value = stat_unpay_num&"/"&stat_all_num&"（"&FormatPercent(stat_unpay_num/stat_all_num)&"）"
xlWorksheet.Cells(5,1).Value = "仅付首款项目"
xlWorksheet.Cells(5,2).Value = stat_fpay_num
xlWorksheet.Cells(5,3).Value = FormatCurrency(stat_fpay_pay)&"（已付："&FormatCurrency(stat_f_payed)&"，未付："&FormatCurrency(stat_l_unpay)&"）"
xlWorksheet.Cells(5,4).Value = stat_fpay_num&"/"&stat_all_num&"（"&FormatPercent(stat_fpay_num/stat_all_num)&"）"
xlWorksheet.Cells(6,1).Value = "未付款项目"
xlWorksheet.Cells(6,2).Value = stat_unpay_num
xlWorksheet.Cells(6,3).Value = FormatCurrency(stat_unpay_pay)
xlWorksheet.Cells(6,4).Value = stat_lpay_num&"/"&stat_all_num&"（"&FormatPercent(stat_lpay_num/stat_all_num)&"）"
'xlWorksheet.Range(xlWorksheet.Cells(8,3), xlWorksheet.Cells(8,4)).MergeCells =True '合并列
xlWorksheet.Cells(8,4).Value = now()

stat_all_num=0
stat_all_pay=0.00
stat_unpay_num=0
stat_unpay_pay=0.00
stat_fpay_num=0
stat_fpay_pay=0.00
stat_lpay_num=0
stat_lpay_pay=0.00
for i=1 to rs.recordcount
	stat_all_num=stat_all_num+1
	stat_all_pay=stat_all_pay+rs("c_total")
	if rs("c_state")="new" or rs("c_state")="audited" then
		stat_unpay_num=stat_unpay_num+1
		stat_unpay_pay=stat_unpay_pay+rs("c_total")
	elseif rs("c_state")="f_passed" then
		stat_fpay_num=stat_fpay_num+1
		stat_fpay_pay=stat_fpay_pay+rs("c_total")
	else
		stat_lpay_num=stat_lpay_num+1
		stat_lpay_pay=stat_lpay_pay+rs("c_total")
	end if
	rs.movenext
next
call DBConnEnd()
Set fs = CreateObject("Scripting.FileSystemObject")
tfile=Server.MapPath("nciae_contract_stat_"&query_time&".xls")
if fs.FileExists(tfile) then
Set f = fs.GetFile(tfile)
f.delete true
Set f = nothing
end if
Set fs = nothing
xlWorksheet.SaveAs tfile '保存文件
xlApplication.Quit '释放对象
Set xlWorksheet = Nothing
Set xlApplication = Nothing


Function downLoadFile(FileSpec)
on error resume next
 Const ForReading=1
 Const TristateTrue=-1 
 Const FILE_TRANSFER_SIZE=1024 '16384
 Dim objFileSystem, objFile, objStream
 Dim char
 Dim sent
 Set objFileSystem = CreateObject("Scripting.FileSystemObject")
 If objFileSystem.FileExists(fileSpec)=false Then
 response.write("<Script>alert(""请求文件不存在！"");history.back();</script>")
 Exit Function
 End If
 FileName = objFileSystem.GetFileName(FileSpec)
 send=0
 TransferFile = True
 Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
 Set objFile = objFileSystem.GetFile(FileSpec)
 Set objStream = objFile.OpenAsTextStream(ForReading, TristateTrue)
 Response.AddHeader "content-type", "application/octet-stream"
 Response.AddHeader "Content-Disposition","attachment;filename=" & filename
 
 Response.AddHeader "content-length", objFile.Size
 Do While Not objStream.AtEndOfStream
 char = objStream.Read(1)
 Response.BinaryWrite(char)
 sent = sent + 1
 If (sent MOD FILE_TRANSFER_SIZE) = 0 Then
 Response.Flush
 If Not Response.IsClientConnected Then
 TransferFile = False
 Exit Do
 End If
 End If
 Loop
 Response.Flush
 If Not Response.IsClientConnected Then TransferFile = False
 objStream.Close
 Set objStream = Nothing
 Set objFileSystem = Nothing
End Function
fileSpec =Lcase(Cstr(Trim(Request("fileSpec"))))
 downLoadFile(tfile)
%>