客户端用ASP+rds+VBA参生报表

test_print_report.asp

 1<html>
 2<head>
 3<meta content="text/html; charset=utf-8" http-equiv="Content-Type"/>
 4<title>client use rds produce excel report</title>
 5</head>
 6<body bgcolor="skyblue" bottommargin="0" leftmargin="20" oncontextmenu="return false" rightmargin="0" topmargin="0">
 7<form action="test_print_report.asp" method="post" name="myform">
 8<div align="center"><center>
 9<table bgcolor="#ffe4b5" border="5" bordercolor="#0000ff" style="HEIGHT: 1px; TOP: 0px">
10<tr>
11<td align="middle" bgcolor="#ffffff" bordercolor="#000080">
12<font color="#000080" size="3">   
13client use rds produce excel report   
14</font>
15</td>
16</tr>
17</table>
18</center></div>
19<div align="left">
20<input language="vbscript" name="query" onclick="fun_query()" style="HEIGHT: 32px; WIDTH: 90px" type="button" value="Query Data"/>
21<input language="vbscript" name="Clear" onclick="fun_clear()" style="HEIGHT: 32px; WIDTH: 90px" type="button" value="Clear Data"/>
22<input language="vbscript" name="report" onclick="fun_excel()" style="HEIGHT: 32px; WIDTH: 90px" type="button" value="Excel Report"/>
23</div>
24<div id="adddata"></div>
25</form>
26</body>
27</html>
  1<script language="vbscript">   
  2dim rds,rs,df   
  3dim strSQL,StrRs,strCn,RowCnt   
  4dim xlApp, xlBook, xlSheet1,xlmodule,XlPageSetup   
  5dim HeadRowCnt,TitleRowCnt,ContentRowCnt,FootRowCnt   
  6dim PageRowCnt,PageNo,TotalPageCnt,ContentRowNowCnt   
  7dim ColumnAllWidth,ColumnAWidth,ColumnBWidth,ColumnCWidth,ColumnDWidth   
  8  
  9sub fun_query()   
 10set rds = CreateObject("RDS.DataSpace")   
 11Set df = rds.CreateObject("RDSServer.DataFactory","http://iscs00074")   
 12strCn="DRIVER={SQL Server};SERVER=iscs00074;UID=sa;APP=Microsoft Development Environment;DATABASE=pubs;User Id=sa;PASSWORD=;"   
 13strSQL = "Select * from jobs"   
 14Set rs = df.Query(strCn, strSQL)   
 15  
 16if not rs.eof then   
 17StrRs="<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>"   
 18adddata.innerHTML=StrRs   
 19StrRs=""   
 20else   
 21msgbox "No data in the table!"   
 22end if   
 23end sub   
 24  
 25sub fun_clear()   
 26StrRs=""   
 27adddata.innerHTML=StrRs   
 28end sub   
 29  
 30sub fun_excel()   
 31set rds = CreateObject("RDS.DataSpace")   
 32Set df = rds.CreateObject("RDSServer.DataFactory","http://iscs00074")   
 33strCn="DRIVER={SQL Server};SERVER=iscs00074;UID=sa;APP=Microsoft Development Environment;DATABASE=pubs;User Id=sa;PASSWORD=;"   
 34strSQL = "Select count(*) as recordcnt from jobs"   
 35Set rs = df.Query(strCn, strSQL)   
 36TotalPageCnt=rs("recordcnt")   
 37rs.close   
 38set rs=nothing   
 39strSQL = "Select * from jobs"   
 40Set rs = df.Query(strCn, strSQL)   
 41Set xlApp = CreateObject("EXCEL.APPLICATION")   
 42Set xlBook = xlApp.Workbooks.Add   
 43Set xlSheet1 = xlBook.ActiveSheet   
 44Set xlmodule = xlbook.VBProject.VBComponents.Add(1)   
 45xlSheet1.Application.Visible = True   
 46xlSheet1.Application.UserControl = True   
 47i=0   
 48RowCnt=1   
 49PageNo=1   
 50HeadRowCnt=4 'The header number to print in one page!   
 51TitleRowCnt=3 'The title number to print in one page!   
 52ContentRowCnt=6 'The record number to print in one page!   
 53FootRowCnt=1 'The footer number to print in one page!   
 54PageRowCnt=HeadRowCnt+TitleRowCnt+ContentRowCnt+FootRowCnt   
 55TotalPageCnt=int((TotalPageCnt+ContentRowCnt-1)/ContentRowCnt)   
 56ColumnAWidth=5 'The ColumnA Width!   
 57ColumnBWidth=30 'The ColumnB Width!   
 58ColumnCWidth=5 'The ColumnC Width!   
 59ColumnDWidth=5 'The ColumnD Width!   
 60'Add the Head and Title   
 61call head_title   
 62'Add the Data   
 63do while not rs.eof   
 64With xlSheet1   
 65.cells(RowCnt,1).value = rs(0)   
 66.cells(RowCnt,2).value = rs(1)   
 67.cells(RowCnt,3).value = rs(2)   
 68.cells(RowCnt,4).value = rs(3)   
 69end with   
 70rs.movenext   
 71ContentRowNowCnt=ContentRowNowCnt+1   
 72if not rs.eof then   
 73if ContentRowNowCnt mod (ContentRowCnt) =0 then   
 74ContentRowNowCnt=0   
 75RowCnt = cint(RowCnt) + 1   
 76'Add the Foot   
 77call foot_title   
 78'Add the Head and Title   
 79call head_title   
 80else   
 81RowCnt = cint(RowCnt) + 1   
 82end if   
 83else   
 84RowCnt = cint(RowCnt) + 1   
 85call foot_title   
 86end if   
 87loop   
 88'Format the Grid and Font   
 89call format_grid   
 90'Release References   
 91'XLSheet1.PrintOut   
 92'xlBook.Saved = True   
 93Set xlmodule = Nothing   
 94Set xlSheet1 = Nothing   
 95Set xlBook = Nothing   
 96xlApp.Quit   
 97Set xlApp = Nothing   
 98rs.close   
 99set rs=nothing   
100end sub   
101  
102  
103sub head_title()   
104dim HeadRow   
105HeadRow=1   
106do while HeadRow<= HeadRowCnt   
107With xlSheet1   
108.range("C"+trim(RowCnt)+":"+"D"+trim(RowCnt)).merge   
109end with   
110RowCnt=RowCnt+1   
111HeadRow=HeadRow+1   
112loop   
113  
114'Format the head name of cells (The new page of row=5,6,7)   
115  
116With xlSheet1   
117.Cells(RowCnt-3, 2).Value = "THE JOB INFORMATION TABLE"   
118.Cells(RowCnt-3, 3).Value = date()   
119.Cells(RowCnt-4, 3).Value = "The "+trim(PageNo)+"/"+trim(TotalPageCnt) +" Pages"   
120end with   
121'Format the title field name of cells   
122With xlSheet1   
123.range("A"+trim(RowCnt) +":B"+trim(RowCnt)).merge   
124.range("A"+trim(RowCnt+1) +":A"+trim(RowCnt+2)).merge   
125.range("B"+trim(RowCnt+1) +":B"+trim(RowCnt+2)).merge   
126  
127.range("C"+trim(RowCnt) +":D"+trim(RowCnt)).merge   
128.range("C"+trim(RowCnt+1) +":C"+trim(RowCnt+2)).merge   
129.range("D"+trim(RowCnt+1) +":D"+trim(RowCnt+2)).merge   
130  
131.Cells(RowCnt, 1).Value = "The job"   
132.Cells(RowCnt+1,1).Value = "job_id"   
133.Cells(RowCnt+1,2).Value = "job_desc"   
134.Cells(RowCnt, 3).Value = "Level"   
135.Cells(RowCnt+1,3).Value = "Max level"   
136.Cells(RowCnt+1,4).Value = "Min level"   
137End With   
138RowCnt=int(RowCnt)+3   
139PageNo=PageNo+1   
140end sub   
141  
142sub foot_title()   
143dim FootRow   
144FootRow=1   
145do while FootRow<= FootRowCnt   
146With xlSheet1   
147.range("C"+trim(RowCnt)+":"+"D"+trim(RowCnt)).merge   
148end with   
149RowCnt=RowCnt+1   
150FootRow=FootRow+1   
151loop   
152With xlSheet1   
153.Cells(RowCnt-1, 1).Value = "A:"   
154.Cells(RowCnt-1, 2).Value = "B:"   
155.Cells(RowCnt-1, 3).Value = "C:"   
156end with   
157end sub   
158  
159sub format_grid()   
160dim strCode   
161dim MyMacro   
162strCode = _   
163"sub MyMacro() " & vbCr & _   
164"dim HeadRowCnt" & vbCr & _   
165"dim TitleRowCnt" & vbCr & _   
166"dim ContentRowCnt" & vbCr & _   
167"dim FootRowCnt" & vbCr & _   
168"dim PageRowCnt" & vbCr & _   
169"dim BgnCnt" & vbCr & _   
170"HeadRowCnt="& HeadRowCnt &"" & vbCr & _   
171"TitleRowCnt="& TitleRowCnt &"" & vbCr & _   
172"ContentRowCnt="& ContentRowCnt &"" & vbCr & _   
173"FootRowCnt="& FootRowCnt &"" & vbCr & _   
174"PageRowCnt=HeadRowCnt+TitleRowCnt+ContentRowCnt+FootRowCnt" & vbCr & _   
175"BgnCnt=1" & vbCr & _   
176"PageNo=1" & vbCr & _   
177"Range(""A""+trim(BgnCnt)+"":D""+trim(BgnCnt)).Select" & vbCr & _   
178"With sheet1" & vbCr & _   
179" .Range(""A1"").ColumnWidth = "& ColumnAWidth&"" & vbCr & _   
180" .Range(""B1"").ColumnWidth = "& ColumnBWidth&"" & vbCr & _   
181" .Range(""C1"").ColumnWidth = "& ColumnCWidth&"" & vbCr & _   
182" .Range(""D1"").ColumnWidth = "& ColumnDWidth&"" & vbCr & _   
183"End With" & vbCr & _   
184"do while PageNo<= "& TotalPageCnt&"" & vbCr & _   
185"if PageNo= "& TotalPageCnt& " then" & vbCr & _   
186" ContentRowCnt="& ContentRowNowCnt &"" & vbCr & _   
187" PageRowCnt=HeadRowCnt+TitleRowCnt+ContentRowCnt+FootRowCnt" & vbCr & _   
188"end if" & vbCr & _   
189"Range(""A""+trim(BgnCnt)+"":D""+trim(BgnCnt+PageRowCnt-1)).Select" & vbCr & _   
190"With Range(""A""+trim(BgnCnt)+"":D""+trim(BgnCnt+PageRowCnt-1))" & vbCr & _   
191" .Borders.LineStyle = xlContnuous" & vbCr & _   
192" .Borders.Weight = xlThin" & vbCr & _   
193" .Borders.ColorIndex = 10" & vbCr & _   
194" .RowHeight = 15" & vbCr & _   
195" .VerticalAlignment = xlCenter" & vbCr & _   
196" .HorizontalAlignment = xlLeft" & vbCr & _   
197" .Font.Size = 9" & vbCr & _   
198"End With" & vbCr & _   
199"With Range(""A""+trim(BgnCnt)+"":D""+trim(BgnCnt+HeadRowCnt-1))" & vbCr & _   
200" .Font.Size = 11" & vbCr & _   
201" .Font.Bold = True" & vbCr & _   
202" .Borders.LineStyle = xlLineStyleNone" & vbCr & _   
203" .VerticalAlignment = xlCenter" & vbCr & _   
204" .HorizontalAlignment = xlCenter" & vbCr & _   
205" .Orientation = xlHorizontal" & vbCr & _   
206"End With" & vbCr & _   
207"With Range(""A""+trim(BgnCnt+HeadRowCnt)+"":D""+trim(BgnCnt+HeadRowCnt+TitleRowCnt-1))" & vbCr & _   
208" .WrapText = True" & vbCr & _   
209" .Font.Size = 9" & vbCr & _   
210" .Font.Bold = True" & vbCr & _   
211" .VerticalAlignment = xlCenter" & vbCr & _   
212" .HorizontalAlignment = xlCenter" & vbCr & _   
213" .Orientation = xlHorizontal" & vbCr & _   
214"end With" & vbCr & _   
215"With Range(""A""+trim(BgnCnt+HeadRowCnt+TitleRowCnt+ContentRowCnt)+"":D""+trim(BgnCnt+HeadRowCnt+TitleRowCnt+ContentRowCnt+FootRowCnt-1))" & vbCr & _   
216" .Font.Size = 9" & vbCr & _   
217" .Font.Bold = True" & vbCr & _   
218" .Borders.LineStyle = xlLineStyleNone" & vbCr & _   
219" .VerticalAlignment = xlCenter" & vbCr & _   
220" .HorizontalAlignment = xlLeft" & vbCr & _   
221" .Orientation = xlHorizontal" & vbCr & _   
222"end With" & vbCr & _   
223"PageNo=PageNo+1" & vbCr & _   
224"BgnCnt=BgnCnt+PageRowCnt" & vbCr & _   
225"loop" & vbCr & _   
226"With Sheet1.PageSetup" & vbCr & _   
227" .HeaderMargin = application.CentimetersToPoints(0)" & vbCr & _   
228" .LeftMargin = application.CentimetersToPoints(2)" & vbCr & _   
229" .RightMargin =application.CentimetersToPoints(2)" & vbCr & _   
230" .TopMargin = application.CentimetersToPoints(1)" & vbCr & _   
231" .BottomMargin = application.CentimetersToPoints(1)" & vbCr & _   
232" .FooterMargin = application.CentimetersToPoints(0)" & vbCr & _   
233"' .Orientation = xlLandscape" & vbCr & _   
234" .Orientation = xlPortrait" & vbCr & _   
235" .CenterHorizontally = True" & vbCr & _   
236" .CenterVertically = False" & vbCr & _   
237" .PaperSize = xlPaperA4" & vbCr & _   
238"End With" & vbCr & _   
239"Range(""A1"").Select" & vbCr & _   
240"end sub"   
241xlmodule.CodeModule.AddFromString (strCode)   
242xlApp.Run "MyMacro"   
243end sub   
244</script>
Published At
Categories with Web编程
Tagged with
comments powered by Disqus