查看: 1931|回复: 0

客户端用ASP+rds+VBA参生报表（高级篇）

20 主题	0 听众	26 积分

应届毕业生

Rank: 1

性别: 保密
听众数: 0
买家信用
卖家信用
在线时间: 0 小时
相册: 0

发表于 2006-8-8 14:08:00 |显示全部楼层

客户端用ASP+rds+VBA参生报表（高级篇） test_print_report.asp <html> <head> <meta content="text/html; charset=BIG5" http-equiv="Content-Type"> <title>client use rds produce excel report</title> </head> <body bgColor="skyblue" topMargin=0 leftMargin="20" oncontextmenu="return false" rightMargin="0" bottomMargin="0"> <form action="test_print_report.asp" method="post" name="myform"> <div align="center"><center> <table border="5" bgcolor="#ffe4b5" style="HEIGHT: 1px; TOP: 0px" bordercolor="#0000ff"> <tr> <td align="middle" bgcolor="#ffffff" bordercolor="#000080"> client use rds produce excel report </td> </tr> </table> </div> <div align="left"> <input type="button" value="Query Data" name="query" language="vbscrip.." onclick="fun_query()" style="HEIGHT: 32px; WIDTH: 90px"> <input type="button" value="Clear Data" name="Clear" language="vbscrip.." onclick="fun_clear()" style="HEIGHT: 32px; WIDTH: 90px"> <input type="button" value="Excel Report" name="report" language="vbscrip.." onclick="fun_excel()" style="HEIGHT: 32px; WIDTH: 90px"> </div> <div id="adddata"></div> </form></center> </body> </html> <scrip.. language="vbscrip.."> dim rds,rs,df dim strsql,StrRs,strCn,RowCnt dim xlApp, xlBook, xlSheet1,xlmodule,XlPageSetup dim HeadRowCnt,TitleRowCnt,ContentRowCnt,FootRowCnt dim PageRowCnt,PageNo,TotalPageCnt,ContentRowNowCnt dim ColumnAllWidth,ColumnAWidth,ColumnBWidth,ColumnCWidth,ColumnDWidth sub fun_query() set rds = CreateObject("RDS.DataSpace") Set df = rds.CreateObject("RDSServer.DataFactory","http://iscs00074") strCn="DRIVER={SQL Server};SERVER=iscs00074;UID=sa;APP=Microsoft Development Environment;DATABASE=pubs;User Id=sa;PASSWORD=;" strSQL = "Select * from jobs" Set rs = df.Query(strCn, strSQL) if not rs.eof then StrRs="<table border=1><tr><td>job_id</td><td>job_desc</td><td>max_lvl</td><td>min_lvl</td></tr><tr><td>"+ rs.GetString(,,"</td><td>","</td></tr><tr><td>"," ") +"</td></tr></table>" adddata.innerHTML=StrRs StrRs="" else msgbo.. "No data in the table!" end if end sub sub fun_clear() StrRs="" adddata.innerHTML=StrRs end sub sub fun_excel() set rds = CreateObject("RDS.DataSpace") Set df = rds.CreateObject("RDSServer.DataFactory","http://iscs00074") strCn="DRIVER={SQL Server};SERVER=iscs00074;UID=sa;APP=Microsoft Development Environment;DATABASE=pubs;User Id=sa;PASSWORD=;" strSQL = "Select count(*) as recordcnt from jobs" Set rs = df.Query(strCn, strSQL) TotalPageCnt=rs("recordcnt") rs.close set rs=nothing strSQL = "Select * from jobs" Set rs = df.Query(strCn, strSQL) Set xlApp = CreateObject("EXCEL.APPLICATION") Set xlBook = xlApp.Workbooks.Add Set xlSheet1 = xlBook.ActiveSheet Set xlmodule = xlbook.VBProject.VBComponents.Add(1) xlSheet1.Application.Visible = True xlSheet1.Application.UserControl = True i=0 RowCnt=1 PageNo=1 HeadRowCnt=4 @#The header number to print in one page! TitleRowCnt=3 @#The title number to print in one page! ContentRowCnt=6 @#The record number to print in one page! FootRowCnt=1 @#The footer number to print in one page! PageRowCnt=HeadRowCnt+TitleRowCnt+ContentRowCnt+FootRowCnt TotalPageCnt=int((TotalPageCnt+ContentRowCnt-1)/ContentRowCnt) ColumnAWidth=5 @#The ColumnA Width! ColumnBWidth=30 @#The ColumnB Width! ColumnCWidth=5 @#The ColumnC Width! ColumnDWidth=5 @#The ColumnD Width! @#Add the Head and Title call head_title @#Add the Data do while not rs.eof With xlSheet1 .cells(RowCnt,1).value = rs(0) .cells(RowCnt,2).value = rs(1) .cells(RowCnt,3).value = rs(2) .cells(RowCnt,4).value = rs(3) end with rs.movenext ContentRowNowCnt=ContentRowNowCnt+1 if not rs.eof then if ContentRowNowCnt mod (ContentRowCnt) =0 then ContentRowNowCnt=0 RowCnt = cint(RowCnt) + 1 @#Add the Foot call foot_title @#Add the Head and Title call head_title else RowCnt = cint(RowCnt) + 1 end if else RowCnt = cint(RowCnt) + 1 call foot_title end if loop @#Format the Grid and Font call format_grid @#Release References @#XLSheet1.PrintOut @#xlBook.Saved = True Set xlmodule = Nothing Set xlSheet1 = Nothing Set xlBook = Nothing xlApp.Quit Set xlApp = Nothing rs.close set rs=nothing end sub sub head_title() dim HeadRow HeadRow=1 do while HeadRow<= HeadRowCnt With xlSheet1 .range("C"+trim(RowCnt)+":"+"D"+trim(RowCnt)).merge end with RowCnt=RowCnt+1 HeadRow=HeadRow+1 loop @#Format the head name of cells (The new page of row=5,6,7) With xlSheet1 .Cells(RowCnt-3, 2).Value = "THE JOB INFORMATION TABLE" .Cells(RowCnt-3, 3).Value = date() .Cells(RowCnt-4, 3).Value = "The "+trim(PageNo)+"/"+trim(TotalPageCnt) +" Pages" end with @#Format the title field name of cells With xlSheet1 .range("A"+trim(RowCnt) +":B"+trim(RowCnt)).merge .range("A"+trim(RowCnt+1) +":A"+trim(RowCnt+2)).merge .range("B"+trim(RowCnt+1) +":B"+trim(RowCnt+2)).merge .range("C"+trim(RowCnt) +":D"+trim(RowCnt)).merge .range("C"+trim(RowCnt+1) +":C"+trim(RowCnt+2)).merge .range("D"+trim(RowCnt+1) +":D"+trim(RowCnt+2)).merge .Cells(RowCnt, 1).Value = "The job" .Cells(RowCnt+1,1).Value = "job_id" .Cells(RowCnt+1,2).Value = "job_desc" .Cells(RowCnt, 3).Value = "Level" .Cells(RowCnt+1,3).Value = "Max level" .Cells(RowCnt+1,4).Value = "Min level" End With RowCnt=int(RowCnt)+3 PageNo=PageNo+1 end sub sub foot_title() dim FootRow FootRow=1 do while FootRow<= FootRowCnt With xlSheet1 .range("C"+trim(RowCnt)+":"+"D"+trim(RowCnt)).merge end with RowCnt=RowCnt+1 FootRow=FootRow+1 loop With xlSheet1 .Cells(RowCnt-1, 1).Value = "A:" .Cells(RowCnt-1, 2).Value = "B:" .Cells(RowCnt-1, 3).Value = "C:" end with end sub sub format_grid() dim strCode dim MyMacro strCode = _ "sub MyMacro() " & vbCr & _ "dim HeadRowCnt" & vbCr & _ "dim TitleRowCnt" & vbCr & _ "dim ContentRowCnt" & vbCr & _ "dim FootRowCnt" & vbCr & _ "dim PageRowCnt" & vbCr & _ "dim BgnCnt" & vbCr & _ "HeadRowCnt="& HeadRowCnt &"" & vbCr & _

ASP.NET源码下载专区

ASP.NET CMS源码下载专区

ASP.NET快速开发框架下载专区

Asp.net视频教程,asp.net教程,文档下载

JQuery插件,Jquery教程,Jquery ui

ASP.NET Extjs 系列专区

ASP.NET Entity Framework 系列专区

ASP.NET MVC 系列专区

使用道具举报