ExCel

最近工作的一个论题,就是要从资料库查询数据,写入一个Excel文件,放在伺服器端!

不过写的过程当中,没有什么困难,真是不像话!贴出代码,以后供自己参考哦~~~~~

<%Option Explicit%>
<!-- #include virtual="/include/adovbs.inc" -->
<!-- #include virtual="/include/DataBase.fun" -->
<!-- #include virtual="/include/Pub_Function.fun" -->
<!-- #include file= "../include/ODM_SPECDOC_SysInfoCheck.fun" -->
<!-- #include virtual="/Authority/Check_Authority.fun" -->
<%
'**********************************************************************
 '*AUTHOR: MabelDeng
 '*CREATE: 2005/11/05
 '*NAME: ODM特性表查詢產品
 '**********************************************************************
%>
<%
 '***權限檢測****
 if Authority_Check(gSysCode,g_GetPageName(),G_GetUser())=0 then
  Web_Stop ("資訊部")  '參數為:Show 連絡之人員或單位等訊息,如無則顯示:資訊部
 end if
%>
<%
dim RcSet,strSQL
dim intK
dim i,flag,BSPEC_NO,ESPEC_NO
 BSPEC_NO = Request.Form("txtBSPEC_NO")
 ESPEC_NO = Request.Form("txtESPEC_NO")
if BSPEC_NO <> "" and BSPEC_NO <> "" then
 strSQL="select * from ODM_SPEC where SPEC_NO >= '" & BSPEC_NO &"' and SPEC_NO <= '" & ESPEC_NO &"'"
else
 strSQL="select * from ODM_SPEC "
end if

set RcSet = GetSQLServerRs(gSQLServerName,gSQLACCName,gSQLPassword,gSQLDBName,strSQL,2)


'if request.Form("flag")="XLS" then  '輸入EXCEL
dim xlApp,oBook,oSheets,oSheet,fso
Dim strName
'*****建立Excel對象******
Set xlApp = server.CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
xlApp.DisplayAlerts  =  false  '不顯示警告                  
xlApp.Application.Visible =false

'*****新建Excel文件******
set oBook=xlApp.Workbooks.Add
set oSheets=oBook.Worksheets
set oSheet=oBook.Sheets(1)

oSheet.Range("A1:G1").Merge  '合並欄A1:G1
oSheet.Range("A1:G1")="Characteristics List"
oSheet.Range("A1:G1").Font.Size = 16
oSheet.Range("A2:G2").Merge  '合並欄A2:G2
oSheet.Range("A2:G2")="Revision:" 
oSheet.Range("A3:C3").Merge  '合並欄A3:C3
oSheet.Range("A3:C3")="Customer:" 
oSheet.Range("D3:G3").Merge  '合並欄D3:G3
oSheet.Range("D3:G3")="Customer Part Number:"  '合並欄D3:G3
oSheet.Range("A4:C4").Merge  '合並欄A4:C4
oSheet.Range("A4:C4")="Supplier:" 
oSheet.Range("D4:D4")="Supplier Part Number:"
oSheet.Range("E4:G4").Merge  '合並欄A4:C4
oSheet.Range("E4:G4")="Number:"
oSheet.Range("A5:C5").Merge  '合並欄A1-I1
oSheet.Range("A5:C5")="Part Name:"  '合並欄A1-I1
oSheet.Range("D5:D5")="Date:"  '合並欄A1-I1
oSheet.Range("E5:G5").Merge  '合並欄A1-I1
oSheet.Range("E5:G5")="Revised date:"  '合並欄A1-I1
oSheet.Range("A6:A6")="Char. No."  '合並欄A1-I1
oSheet.Range("B6:B6")="Catelogy"  '合並欄A1-I1
oSheet.Range("C6:C6")="Description"  '合並欄A1-I1
oSheet.Range("D6:D6")="Specifications"  '合並欄A1-I1
oSheet.Range("E6:E6")="SCM"  '合並欄A1-I1
oSheet.Range("F6:F6")="Test type"  '合並欄A1-I1
oSheet.Range("G6:G6")="Remarks"  '合並欄A1-I1
oSheet.Cells(1,1).HorizontalAlignment  = -4108
oSheet.Cells(1,1).Font.Bold = True
oSheet.Cells(2,1).Font.Bold = True
oSheet.Range("A1:G1").Font.Bold = True
oSheet.Range("A2:G2").Font.Bold = True
oSheet.Range("A3:G3").Font.Bold = True
oSheet.Range("A3:G3").Borders.LineStyle = 1 '加格線
oSheet.Range("A4:G4").Font.Bold = True
oSheet.Range("A4:G4").Borders.LineStyle = 1 '加格線
oSheet.Range("A5:G5").Font.Bold = True
oSheet.Range("A5:G5").Borders.LineStyle = 1 '加格線
oSheet.Range("A6:G6").Font.Bold = True
oSheet.Range("A6:G6").Borders.LineStyle = 1 '加格線
oSheet.cells(6,1)="Char. No." :   oSheet.Columns("A:A").ColumnWidth = 7
oSheet.Range("A1:G1").Font.Size = 12 '**字體大小為9
oSheet.Cells(6,1).Font.Bold = True
oSheet.Cells(6,1).HorizontalAlignment  = -4108 '居中
oSheet.cells(6,2)="Catelogy" : oSheet.Columns("B:B").ColumnWidth = 7
oSheet.Cells(6,2).Font.Bold = True
oSheet.Cells(6,2).HorizontalAlignment  = -4108
oSheet.cells(6,3)="Description" : oSheet.Columns("C:C").ColumnWidth = 30.25
oSheet.Cells(6,3).Font.Bold = True
oSheet.Cells(6,3).HorizontalAlignment  = -4108
oSheet.cells(6,4)="Specifications" : oSheet.Columns("D:D").ColumnWidth = 34.25
oSheet.Cells(6,4).Font.Bold = True
oSheet.Cells(6,4).HorizontalAlignment  = -4108
oSheet.cells(6,5)="SCM" :  oSheet.Columns("E:E").ColumnWidth = 4
oSheet.Cells(6,5).Font.Bold = True
oSheet.Cells(6,5).HorizontalAlignment  = -4108
oSheet.cells(6,6)="Test type" : oSheet.Columns("F:F").ColumnWidth = 8
oSheet.Cells(6,6).Font.Bold = True
oSheet.Cells(6,6).HorizontalAlignment  = -4108
oSheet.cells(6,7)="Remarks" : oSheet.Columns("G:G").ColumnWidth = 10
oSheet.Cells(6,7).Font.Bold = True
oSheet.Cells(6,7).HorizontalAlignment  = -4108
intK = 7
do until RcSet.eof
 oSheet.Range("A" & intK & ":" & "G" & intK).Font.Size = 10 '**字體大小為9
 oSheet.Range("A" & intK & ":" & "G" & intK).Borders.LineStyle = 1 '加格線
 oSheet.cells(intK,1).HorizontalAlignment  = -4108
 oSheet.cells(intK,1)=RcSet("SPEC_NO") 
 oSheet.cells(intK,2).HorizontalAlignment  = -4108
 oSheet.cells(intK,2)=getFIELDNam("Material",RcSet("SPEC_Material"))
 oSheet.cells(intK,3)=RcSet("SPEC_Content")
 oSheet.cells(intK,4)=RcSet("SPEC_Standard")
 oSheet.cells(intK,5)=""
 oSheet.cells(intK,6).HorizontalAlignment  = -4108
 oSheet.cells(intK,6)=getFIELDNam("TestPattern",RcSet("SPEC_TestPattern"))
 oSheet.cells(intK,7)=RcSet("SPEC_REM")
 
  '***RcSet("CED_FEE_VENNAM")

 RcSet.movenext
 intK = intK + 1
loop
oSheet.cells(intK,1)="核准:"
oSheet.cells(intK,4)="審核:"
oSheet.cells(intK,6)="製表:"

strName = fso.GetTempName()
oSheet.SaveAs server.MapPath("../TSFiles") & "/" & Left(strName, Len(strName) - 4) & ".xls"
xlApp.quit
set oSheet=nothing
set oSheets=nothing
set oBook=nothing
set xlApp=nothing
set fso=nothing
response.Redirect "../TSFiles/" & Left(strName, Len(strName) - 4) & ".xls"
response.End
%>

我自己要求比较简单,于是我还网上找了一些文章,摘录如下:

文章一:ASP操作Excel技术总结



目录
一、  环境配置
二、  ASP对Excel的基本操作
三、  ASP操作Excel生成数据表
四、  ASP操作Excel生成Chart图
五、  服务器端Excel文件浏览、下载、删除方案
六、  附录

正文
一、  环境配置
服务器端的环境配置从参考资料上看,微软系列的配置应该都行,即:
1.Win9x+PWS+Office
2.Win2000 Professional+PWS+Office
3.Win2000 Server+IIS+Office
目前笔者测试成功的环境是后二者。Office的版本没有特殊要求,考虑到客户机配置的不确定性和下兼容特性,建议服务器端Office版本不要太高,以防止客户机下载后无法正确显示。
服务器端环境配置还有两个偶然的发现是:
1.  笔者开发机器上原来装有金山的WPS2002,结果Excel对象创建始终出现问题,卸载WPS2002后,错误消失。
2.  笔者开发ASP代码喜欢用FrontPage,结果发现如果FrontPage打开(服务器端),对象创建出现不稳定现象,时而成功时而不成功。扩展考察后发现,Office系列的软件如果在服务器端运行,则Excel对象的创建很难成功。
服务器端还必须要设置的一点是COM组件的操作权限。在命令行键入“DCOMCNFG”,则进入COM组件配置界面,选择Microsoft Excel后点击属性按钮,将三个单选项一律选择自定义,编辑中将Everyone加入所有权限。保存完毕后重新启动服务器。
客户端的环境配置没发现什么特别讲究的地方,只要装有Office和IE即可,版本通用的好象都可以。

二、  ASP对Excel的基本操作
1、  建立Excel对象
set objExcelApp = CreateObject("Excel.Application")
objExcelApp.DisplayAlerts = false    不显示警告
objExcelApp.Application.Visible = false    不显示界面
2、  新建Excel文件
objExcelApp.WorkBooks.add
set objExcelBook = objExcelApp.ActiveWorkBook
set objExcelSheets = objExcelBook.Worksheets
set objExcelSheet = objExcelBook.Sheets(1)
3、  读取已有Excel文件
strAddr = Server.MapPath(".")
objExcelApp.WorkBooks.Open(strAddr & "/Templet/Table.xls")
set objExcelBook = objExcelApp.ActiveWorkBook
set objExcelSheets = objExcelBook.Worksheets
set objExcelSheet = objExcelBook.Sheets(1)
4、  另存Excel文件
objExcelBook.SaveAs strAddr & "/Temp/Table.xls"
5、  保存Excel文件
objExcelBook.Save    (笔者测试时保存成功,页面报错。)
6、  退出Excel操作
objExcelApp.Quit  一定要退出
set objExcelApp = Nothing

三、  ASP操作Excel生成数据表
1、  在一个范围内插入数据
objExcelSheet.Range("B3:k3").Value = Array("67", "87", "5", "9", "7", "45", "45", "54", "54", "10")
2、  在一个单元格内插入数据
objExcelSheet.Cells(3,1).Value="Internet Explorer"
3、  选中一个范围
4、  单元格左边画粗线条
5、  单元格右边画粗线条
6、  单元格上边画粗线条
7、  单元格下边画粗线条
8、  单元格设定背景色
9、  合并单元格
10、  插入行
11、  插入列

四、  ASP操作Excel生成Chart图
1、  创建Chart图
objExcelApp.Charts.Add
2、  设定Chart图种类
objExcelApp.ActiveChart.ChartType = 97
注:二维折线图,4;二维饼图,5;二维柱形图,51
3、  设定Chart图标题
objExcelApp.ActiveChart.HasTitle = True
objExcelApp.ActiveChart.ChartTitle.Text = "A test Chart"
4、  通过表格数据设定图形
objExcelApp.ActiveChart.SetSourceData objExcelSheet.Range("A1:k5"),1
5、  直接设定图形数据(推荐)
objExcelApp.ActiveChart.SeriesCollection.NewSeries
objExcelApp.ActiveChart.SeriesCollection(1).Name = "=""333"""
objExcelApp.ActiveChart.SeriesCollection(1).Values = "="
6、  绑定Chart图
objExcelApp.ActiveChart.Location 1
7、  显示数据表
objExcelApp.ActiveChart.HasDataTable = True
8、  显示图例
objExcelApp.ActiveChart.DataTable.ShowLegendKey = True

五、  服务器端Excel文件浏览、下载、删除方案
浏览的解决方法很多,“Location.href=”,“Navigate”,“Response.Redirect”都可以实现,建议用客户端的方法,原因是给服务器更多的时间生成Excel文件。
下载的实现要麻烦一些。用网上现成的服务器端下载组件或自己定制开发一个组件是比较好的方案。另外一种方法是在客户端操作Excel组件,由客户端操作服务器端Excel文件另存至客户端。这种方法要求客户端开放不安全ActiveX控件的操作权限,考虑到通知每个客户将服务器设置为可信站点的麻烦程度建议还是用第一个方法比较省事。
删除方案由三部分组成:
A:  同一用户生成的Excel文件用同一个文件名,文件名可用用户ID号或SessionID号等可确信不重复字符串组成。这样新文件生成时自动覆盖上一文件。
B:  在Global.asa文件中设置Session_onEnd事件激发时,删除这个用户的Excel暂存文件。
C:  在Global.asa文件中设置Application_onStart事件激发时,删除暂存目录下的所有文件。
注:建议目录结构 /Src 代码目录 /Templet 模板目录 /Temp 暂存目录

六、  附录
出错时Excel出现的死进程出现是一件很头疼的事情。在每个文件前加上“On Error Resume Next”将有助于改善这种情况,因为它会不管文件是否产生错误都坚持执行到“Application.Quit”,保证每次程序执行完不留下死进程。

sql="select * from [tx_use]" '这里是要输出EXCEL的查询语句,如 "SESECT * FORM CAI WHERE 性别='女'"
filename="excel.xls" ' 要输出的EXCEL文件的文件名, 你只要改以上两句就行了,其它的都不要改.

'你只要修改以上两变量就行了.其它的我都做好了.

call toexcel(FILENAME,sql)
set conn=nothing

function ReadText(FileName) '这是一个用于读出文件的函数
set adf=server.CreateObject("Adodb.Stream")
with adf
.Type=2
.LineSeparator=10
.Open
.LoadFromFile (server.MapPath(FileName))
.Charset="GB2312"
.Position=2
ReadText=.ReadText
.Cancel()
.Close()
end with
set ads=nothing
end function

sub SaveText(FileName,Data) '这是一个用于写文件的函数
set fs= createobject("scripting.filesystemobject")
set ts=fs.createtextfile(server.MapPath(FileName),true)
ts.writeline(data)
ts.close
set ts=nothing
set fs=nothing
end sub

sub toexcel(filename,sql) '这是一个根据SQL语句和FILENAME生成EXCEL文件
Set rs=Server.CreateObject("ADODB.RecordSet")
rs.Open sql,conn,1,3
TOEXCELLR="<table width='100%'><tr >"
set myfield=rs.fields
dim fieldname(50)
for i=0 to myfield.count-1
toexcellr=toexcellr&"<td class=xl24>"&MYFIELD(I).NAME&"</td>"
fieldname(i)=myfield(i).name
if myfield(i).type=135 then datename=datename&myfield(i).name&","
next
toexcellr=toexcellr&"</tr>"
do while not rs.eof
toexcellr=toexcellr&"<tr>"
for i=0 to myfield.count-1
if instr(datename,fieldname(i)&",")<>0 then
if not isnull(rs(fieldname(i))) then
TOEXCELLR=TOEXCELLR&"<td class=xl25 ><p align='left'>"&formatdatetime(rs(fieldname(i)),2)&"</p></td>"
else
TOEXCELLR=TOEXCELLR&"<td class=xl25 ><p align='left'> </p></td>"
end if
else
TOEXCELLR=TOEXCELLR&"<td class=xl24 >"&rs(fieldname(i))&"</td>"
end if
next
toexcellr=toexcellr&"</tr>"
rs.movenext
loop
toexcellr=toexcellr&"</table>"
tou=readtext("tou.txt")
di=readtext("di.txt")
toexcellr=tou&toexcellr&di
call savetext(filename,toexcellr)
end sub
%>
<html>
<head>
<meta http-equiv="refresh" content="3;URL=<%=filename%>">
<meta http-equiv="Content-Language" content="en-us">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>正在生成EXLCE文件</title>
</head>
<BODY>
正在生成EXLCE文件....
</BODY>
</HTML>

**************第二个文件名为:di.txt 内容如下:

<table x:str border=0 cellpadding=0 cellspacing=0 width=288 style='border-collapse:
collapse;table-layout:fixed;width:216pt'>
<![if supportMisalignedColumns]>
<tr height=0 style='display:none'>
<td width=72 style='width:54pt'></td>
<td width=72 style='width:54pt'></td>
<td width=72 style='width:54pt'></td>
<td width=72 style='width:54pt'></td>
</tr>
<![endif]>
</table>

************第三个文件的文件名为:tou.TXT 内容如下:


<html xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns="http://www.w3.org/TR/REC-html40">

<head>
<meta http-equiv=Content-Type content="text/html; charset=GB2312">
<meta name=ProgId content=Excel.Sheet>
<meta name=Generator content="Microsoft Excel 9">
<link rel=File-List href="./222.files/filelist.xml">
<link rel=Edit-Time-Data href="./222.files/editdata.mso">
<link rel=OLE-Object-Data href="./222.files/oledata.mso">
<!--[if gte mso 9]><xml>
<DocumentProperties>
<Author>xky</Author>
<LastAuthor>xky</LastAuthor>
<Created>2002-05-27T17:51:00Z</Created>
<LastSaved>2002-06-22T10:03:03Z</LastSaved>
<Company>zydn</Company>
<Version>9.2812</Version>
</DocumentProperties>
<OfficeDocumentSettings>
<DownloadComponents/>
<LocationOfComponents HRef="file:///E:/msowc.cab"/>
</OfficeDocumentSettings>
</xml><![endif]-->
<style>
<!--table
{mso-displayed-decimal-separator:"/.";
mso-displayed-thousand-separator:"/,";}
@page
{margin:1.0in .75in 1.0in .75in;
mso-header-margin:.5in;
mso-footer-margin:.5in;}
tr
{mso-height-source:auto;
mso-ruby-visibility:none;}
col
{mso-width-source:auto;
mso-ruby-visibility:none;}
br
{mso-data-placement:same-cell;}
.style0
{mso-number-format:General;
text-align:general;
vertical-align:bottom;
white-space:nowrap;
mso-rotate:0;
mso-background-source:auto;
mso-pattern:auto;
color:windowtext;
font-size:9.0pt;
font-weight:400;
font-style:normal;
text-decoration:none;
font-family:宋体;
mso-generic-font-family:auto;
mso-font-charset:134;
border:none;
mso-protection:locked visible;
mso-style-name:常规;
mso-style-id:0;}
td
{mso-style-parent:style0;
padding-top:1px;
padding-right:1px;
padding-left:1px;
mso-ignore:padding;
color:windowtext;
font-size:9.0pt;
font-weight:400;
font-style:normal;
text-decoration:none;
font-family:宋体;
mso-generic-font-family:auto;
mso-font-charset:134;
mso-number-format:General;
text-align:general;
vertical-align:bottom;
border:none;
mso-background-source:auto;
mso-pattern:auto;
mso-protection:locked visible;
white-space:nowrap;
mso-rotate:0;}
.xl24
{mso-style-parent:style0;
border:.5pt solid windowtext;}
.xl25
{mso-style-parent:style0;
mso-number-format:"Long Date";
text-align:left;
border:.5pt solid windowtext;}
ruby
{ruby-align:left;}
rt
{color:windowtext;
font-size:9.0pt;
font-weight:400;
font-style:normal;
text-decoration:none;
font-family:宋体;
mso-generic-font-family:auto;
mso-font-charset:134;
mso-char-type:none;
display:none;}
-->
</style>
<!--[if gte mso 9]><xml>
<x:ExcelWorkbook>
<x:ExcelWorksheets>
<x:ExcelWorksheet>
<x:Name>Sheet1</x:Name>
<x:WorksheetOptions>
<x:DefaultRowHeight>225</x:DefaultRowHeight>
<x:Print>
<x:ValidPrinterInfo/>
<x:PaperSizeIndex>9</x:PaperSizeIndex>
<x:HorizontalResolution>-3</x:HorizontalResolution>
<x:VerticalResolution>0</x:VerticalResolution>
</x:Print>
<x:Selected/>
<x:Panes>
<x:Pane>
<x:Number>3</x:Number>
<x:ActiveRow>24</x:ActiveRow>
<x:ActiveCol>5</x:ActiveCol>
</x:Pane>
</x:Panes>
<x:ProtectContents>False</x:ProtectContents>
<x:ProtectObjects>False</x:ProtectObjects>
<x:ProtectScenarios>False</x:ProtectScenarios>
</x:WorksheetOptions>
</x:ExcelWorksheet>
<x:ExcelWorksheet>
<x:Name>Sheet2</x:Name>
<x:WorksheetOptions>
<x:DefaultRowHeight>225</x:DefaultRowHeight>
<x:ProtectContents>False</x:ProtectContents>
<x:ProtectObjects>False</x:ProtectObjects>
<x:ProtectScenarios>False</x:ProtectScenarios>
</x:WorksheetOptions>
</x:ExcelWorksheet>
<x:ExcelWorksheet>
<x:Name>Sheet3</x:Name>
<x:WorksheetOptions>
<x:DefaultRowHeight>225</x:DefaultRowHeight>
<x:ProtectContents>False</x:ProtectContents>
<x:ProtectObjects>False</x:ProtectObjects>
<x:ProtectScenarios>False</x:ProtectScenarios>
</x:WorksheetOptions>
</x:ExcelWorksheet>
</x:ExcelWorksheets>
<x:WindowHeight>6600</x:WindowHeight>
<x:WindowWidth>12000</x:WindowWidth>
<x:WindowTopX>0</x:WindowTopX>
<x:WindowTopY>1395</x:WindowTopY>
<x:ProtectStructure>False</x:ProtectStructure>
<x:ProtectWindows>False</x:ProtectWindows>
</x:ExcelWorkbook>
</xml><![endif]-->
</head>

<body link=blue vlink=purple>

文章二:

如何从数据库中导出EXECL表- -

                                      

leadbbs搜集:


<script language="VBS" type="text/javascript"> </script><%@ Language=VBScript %>
<script language="VBS">
sub backto()
end sub
<%
idcheckboxA = split(request.form("idcheckbox"),",")

query_sqlT=""

for j = 0 to ubound(idcheckboxA)
           id=trim(idcheckboxA(j))
           if query_sqlT="" then
           query_sqlT="select * From workerinfo where WorkerNo='"&id&"' and LTDate IS NULL"
           else
           query_sqlT=query_sqlT + " or WorkerNo='"&id&"'"
           end if
next
%>

dim obj
set obj=CreateObject("Excel.Application")
     dim objXls
     dim sSql
     dim iCount
     dim iIndex,idir,istr,iend,count,ipage,userunit,line,str_text, i
     err.clear
     
     obj.Visible=True
     obj.Workbooks.Add      
     if Err.number <> 0 then
     '出错      
           set obj=Nothing
           msgbox "本机没有安装Excel97或者生成新文件时出错!",16,"输出到Excel"
     else
     <%
           SET cn_Manpower = SERVER.CreateObject("ADODB.Connection")
     SET rs_workerinfo    = SERVER.CreateObject("ADODB.Recordset")
     
     cn_Manpower.Open Application("Manpower_ConnectString")
     'response.write "'"&session("excel_querysql")
     if query_sqlT <> "" then
     session("excel_querysql") = query_sqlT
     end if
     rs_workerinfo.Open session("excel_querysql"),cn_Manpower,1
     totalcol = rs_workerinfo.Fields.count - 71
     %>      
           
           dim totalcol
           totalcol=<%=totalcol%>
           
           With obj.ActiveWorkBook.Activesheet
                 .columns(1).columnwidth = 10  '栏宽
                 .columns(1).HorizontalAlignment = -4108 '格式居中
                 .columns(2).columnwidth = 6
                 .columns(2).HorizontalAlignment = -4108
                 .columns(3).columnwidth =3
                 .columns(3).HorizontalAlignment = -4108
                 .columns(4).columnwidth = 10
                 .columns(4).HorizontalAlignment = -4131
                 .columns(30).columnwidth =10
                 .columns(30).HorizontalAlignment = -4108
                 .columns(31).columnwidth =25
                 .columns(31).HorizontalAlignment = -4108
                 for j=1 to 36                  
                 .columns(j).WrapText =1
                 next
                 .Rows.RowHeight =24.75 '行高
                 .columns.font.size = 9 '定义字号
                 .columns.font.name = "宋体"  '定义字体
                 .columns.VerticalAlignment = -4108 '设置格式
                 '.columns.font.colorIndex = 11
                 
                 .Rows(1).HorizontalAlignment = -4108
                 .Rows(1).RowHeight=28.5
                 .Range(.cells(1,1), .cells(1,totalcol)).Merge
                 '.Range("A1:AJ1").Merge
                 .Range(.cells(1,1), .cells(1,totalcol)).font.name="楷体_GB2312"
                 .Range(.cells(1,1), .cells(1,totalcol)).font.colorIndex=0
                 .Range(.cells(1,1), .cells(1,totalcol)).font.size=18
                 .Range(.cells(1,1), .cells(1,totalcol)) ="员 工 档 案 表"
                 .Range(.cells(1,1), .cells(1,totalcol)).Interior.ColorIndex = 37
                 .Range(.cells(1,1), .cells(1,totalcol)).Interior.Pattern = 1
                 
                 i = 2
                 .Rows(2).HorizontalAlignment = -4108
                 .Range(.cells(i,1), .cells(i,totalcol)).Interior.ColorIndex = 34
                 .Range(.cells(i,1), .cells(i,totalcol)).Interior.Pattern = 1
                 
                 .Cells(i, 1) = "员工账号"  '自己加你想要的东西
                 i=2
                 <%
                 i = 2
                 If not rs_workerinfo.EOF  then
                 
                       Do while not rs_workerinfo.Eof
                       i = i + 1
                             response.write ".cells("& i &",1) ="""& rs_workerinfo("ITCODE") &""""&chr(13)
                             '你要输出地东西
                             rs_workerinfo.MoveNext
                       Loop
                       end if                        
                 %>                  
                       i = <%=i%>
                 with .Range(.Cells(1,1), .Cells(i, totalcol)).Borders(7) '画左边界
                             .LineStyle = 1
                             .Weight = -4138
                             .ColorIndex = -4105
                 End with
                 with .Range(.Cells(1,1), .Cells(i, totalcol)).Borders(8) '画上边界
                             .LineStyle = 1
                             .Weight = -4138
                             .ColorIndex = -4105
                 End with
                 with .Range(.Cells(1,1), .Cells(i, totalcol)).Borders(9) '画右边界
                             .LineStyle = 1
                             .Weight = -4138
                             .ColorIndex = -4105
                 End with
                 with .Range(.Cells(1,1), .Cells(i, totalcol)).Borders(10) '画下边界
                             .LineStyle = 1
                             .Weight = -4138
                             .ColorIndex = -4105
                 End with
                 with .Range(.Cells(1,1), .Cells(i, totalcol)).Borders(11) '画下边界
                             .LineStyle = 1
                             .Weight = 2
                             .ColorIndex = -4105
                 End with
                 with .Range(.Cells(1,1), .Cells(i, totalcol)).Borders(12) '画下边界
                             .LineStyle = 1
                             .Weight = 2
                             .ColorIndex = -4105
                 End with
           
           'obj.ScreenUpdating = True
     set obj=nothing      
           End with
           '写数据到Excel表中
end if


'history.back()
call backto()

</script>
<%
Function db_get_value ( tablename , by_colname , by_value , ret_colname )

     str_sql ="SELECT " & ret_colname & " from " & tablename  & " WHERE " & by_colname & "='" & by_value &"'"


     SET rs_db_get_value    = SERVER.CreateObject("ADODB.Recordset")
     rs_db_get_value.Open str_sql,cn_Manpower,1
     Dim rcdset,str_sql , ret_value
     dim cnt , cntName


     If Err.number <> 0 Then
           msgbox "数据表["&tablename&"]错误!"
           Err.Clear
     End if
     IF Not rs_db_get_value.EOF then
           ret_value =rs_db_get_value( ret_colname )
           
     End If            
           rs_db_get_value.Close
           db_get_value = ret_value
      set rs_db_get_value = nothing
End Function
%>

<script language="VBS" type="text/javascript"> </script>

//其它项自己更改即可。。

文章三:关于asp程序的Server.CreateObject错误解决方法  

 在Asp程序CreateObject的时候发生错误,大致内容为Server 对象 错误 ’ASP 0178 : 80070005’ ,这一般发生在较高版本的IIS或者Windows平台上,在部分机器上可能会没有什么问题(后面你会知道原因)... 
如果你使用的是中文版,错误信息如下:  
Server 对象 错误 ’ASP 0178 : 80070005’  
Server.CreateObject 访问错误  
/yjst/ExportWorkList.asp,行 62  
检查权限时,对 Server.CreateObject 的调用失败。拒绝对此对象的访问。  
如果你使用的是英文版,错误信息如下: 
Error Type: 
Server object, ASP 0178 (0x80070005) 
The call to Server.CreateObject failed while checking permissions. Access is denied to this object. 
/yjst/ExportWorkList.asp, line 62 
解决方法: 
  我当时是在调用"server.createObject("excel.application")"的时候发生的错误,到很多网站上查,包括微软的方法也尝试了,但是 
不行。后来是这样解决的: 
  开始->运行->dcomcnfg 
  找到"Microsoft Excel 应用程序"(这个名称取决于你调用的Object是什么),然后右键->Properties->security把三个权限都给everyone即可,其实第一个Launch & activate即可

=============

实验证明,低版本的操作系统没有这个问题,我家里是没有打sp的xp系统,正常运行;我公司服务器Win2000最新补丁包,也没问题;但是公司机器winxp大政府版(升级最新补丁)就不能运行,提示此错误,怎么配置都不能解决问题;另外服务器上必须装excel才能支持Excel.Application对象

我把我运行成功的代码贴出来:
<!--#include file="conn.asp" -->
<html>
<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>导出Excel表</title>
</head>
<body>
<%
Call Main
Sub Main
Dim rs
On error resume next
set Rs= server.CreateObject ("adodb.recordset")
sql="select * from NC_chusheng"
rs.open sql,conn,1,3

Dim App,Book,Shts,Sht
set App = CreateObject("Excel.Application")

App.DisplayAlerts = false ’不显示警告
App.Application.Visible = false ’不显示界面
’添加Excel表
’App.WorkBooks.add
App.Workbooks.Open(server.mappath("birth.xlt"))                 ’打开Excel模板 
App.Sheets(1).select                                           ’选中工作页 
set sheetActive=App.ActiveWorkbook.ActiveSheet 
set Book = App.ActiveWorkBook
set Shts = Book.Worksheets
set Sht = Book.Sheets(1)
’Sht.Range("A1:O1").Value = Array("姓名","月份")
Dim r ’行数
r=9   ’从第二行开始写
Dim DeferOctEmp,IsCheck
do while not rs.eof
   Sht.Range("A"&r&":N"&r).Value=Array(rs("dwname"), rs("boyz"),rs("girlz"),rs("jihuaneiz"),rs("1boy"),rs("1girl"),rs("1jihuanei"),rs("wanyu"),rs("2boy"),rs("2girl"),rs("2jihuanei"),rs("duoboy"),rs("duogirl"),rs("loubao"))
rs.movenext
r=r+1
loop
rs.close
set rs=nothing
’设置自动列宽
Sht.Range("A1:N"&(r-1)).Columns.AutoFit
’保存Excel文件
Dim ExcelFile
ExcelFile="Excel1.xls"
Book.SaveAs Server.MapPath(ExcelFile)
if err.Number<>0 then
   App.Quit
   set App = Nothing
   exit sub
end if
Book.Save
App.Quit
set App = Nothing
Response.Redirect ExcelFile
End Sub
conn.close
set conn=nothing
%>
</body>
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值