| 副标题[/!--empirenews.page--] 在一个intranet环境中,如果可以假设客户机上存在特定的浏览器和一些功能强大的软件(如IE5和Office 2000),那么就有能力利用Office Web组件提供一个交互式图形开发环境。这种模式下,客户端工作站将在整个任务中分担很大的比重。 <%
 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 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.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 xxxx","Provider=SQLOLEDB.1;Persist Security
 
 Info=True;User ID=xxxx;Password=xxxx;Initial Catalog=xxxx;Data source=xxxx;" Dim SaveName
 SaveName = Request.Cookies("savename")("name")
 Dim objExcel
 Dim ExcelPath
 ExcelPath = "Excel"" & SaveName & ".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
 %>?
 
 二、用Excel的Application组件在客户端导出到Excel或Word 
 注意:两个函数中的“data“是网页中要导出的table的 id
 
 <input type="hidden" name="out_word" onclick="vbscript:buildDoc" value="导出到word" class="notPrint"> <input type="hidden" name="out_excel" onclick="AutomateExcel();" value="导出到excel" class="notPrint">?
 
 导出到Excel代码 <SCRIPT LANGUAGE="javascript">
 <!--
 function AutomateExcel()
 {
 // Start Excel and get Application object.
 var oXL = new ActiveXObject("Excel.Application");
 // Get a new workbook.
 var oWB = oXL.Workbooks.Add();
 var oSheet = oWB.ActiveSheet;
 var table = document.all.data;
 var hang = table.rows.length;
 var lie = table.rows(0).cells.length;
 
 // Add table headers going cell by cell. for (i=0;i<hang;i++)
 {
 for (j=0;j<lie;j++)
 {
 oSheet.Cells(i+1,j+1).value = table.rows(i).cells(j).innerText;
 }
 }
 oXL.Visible = true;
 oXL.UserControl = true;
 }
 //-->
 </SCRIPT>?
 
 导出到Word代码 <script language="vbscript">
 Sub buildDoc
 set table = document.all.data
 row = table.rows.length
 column = table.rows(1).cells.length
 Set objWordDoc = CreateObject("Word.Document")
 objWordDoc.Application.Documents.Add theTemplate,False
 objWordDoc.Application.Visible=True
 Dim theArray(20,10000)
 for i=0 to row-1
 for j=0 to column-1
 theArray(j+1,i+1) = table.rows(i).cells(j).innerTEXT
 next
 next
 objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("综合查询结果集") //显示表格标题
 
 objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("") Set rngPara = objWordDoc.Application.ActiveDocument.Paragraphs(1).Range
 With rngPara
 .Bold = True //将标题设为粗体
 .ParagraphFormat.Alignment = 1 //将标题居中
 .Font.Name = "隶书" //设定标题字体
 .Font.Size = 18 //设定标题字体大小
 End With
 Set rngCurrent = objWordDoc.Application.ActiveDocument.Paragraphs(3).Range
 Set tabCurrent = ObjWordDoc.Application.ActiveDocument.Tables.Add(rngCurrent,row,column)
 
 for i = 1 to column  
 (编辑:源码网) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |