ASP导出EXCEL

最新推荐文章于 2022-01-17 15:52:17 发布

原创最新推荐文章于 2022-01-17 15:52:17 发布 · 2.5k 阅读

·

1

·

本内容遵循CC 4.0 BY-SA版权协议

版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。

标签

#asp #excel #function #工作 #file

本文介绍了一种使用XSL.ASP脚本自动生成Excel文件的方法。通过创建Excel对象并设定其属性来实现工作表的生成与数据填充。此外，还提供了设置单元格格式、合并单元格等功能，并实现了从数据库读取数据自动填充到Excel表格中。

XSL.ASP

<%

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="统计" '指定工作表名称

'指定列的宽度以及对齐方式 1左对齐 2右对齐 3居中

xlApplication.ActiveSheet.Columns(1).ColumnWidth=5

xlApplication.ActiveSheet.Columns(1).HorizontalAlignment=3

xlApplication.ActiveSheet.Columns(2).ColumnWidth=10

xlApplication.ActiveSheet.Columns(2).HorizontalAlignment=3

xlApplication.ActiveSheet.Columns(3).ColumnWidth=20

xlApplication.ActiveSheet.Columns(3).HorizontalAlignment=3

'xlApplication.ActiveSheet.Rows(i).RowHeight = 30'行的高度

'指定列的高度以及特定列

xlWorksheet.Range(xlWorksheet.Cells(1,1), xlWorksheet.Cells(1,3)).MergeCells =True '合并列

xlWorksheet.Range("A1").value="2005年统计"

xlWorksheet.Range("A1").font.Size=14'字体大小

xlWorksheet.Range("A1").font.bold=true'粗体

xlWorksheet.Range("A1").HorizontalAlignment=3'水平对齐

xlWorksheet.Range("A1").VerticalAlignment=3'垂直对齐

xlWorksheet.Cells(2,1).Value = "编号"

xlWorksheet.Cells(2,2).Value = "姓名"

xlWorksheet.Cells(2,3).Value = "单位"

'xlWorksheet.Range("A1:C1").Borders.LineStyle=1 '设置行style

'--------------------------------------------------自己可做循环i=i+1（数据库数据）

i=1

strSql = "select * from excel"

Set rs =conn.execute(strSql)

if not rs.eof then

do while not rs.eof

xlWorksheet.Cells(2+i,1).Value = rs(0)

xlWorksheet.Cells(2+i,2).Value = rs(1)

xlWorksheet.Cells(2+i,3).Value = rs(2)

i=i+1

rs.movenext

loop

end if

'--------------------------------------------------

Set fs = CreateObject("Scripting.FileSystemObject")

tfile=Server.MapPath("test.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

%>

<p align="center"><a href="downfile.asp?fileSpec=<%=tfile%>">下载</a></p>

downfile.asp

<%

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(fileSpec)

%>

评论

被折叠的条评论为什么被折叠?

到【灌水乐园】发言

查看更多评论

添加红包

成就一亿技术人!

hope_wisdom

发出的红包

实付元

使用余额支付

点击重新获取

扫码支付

钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。