Test_print_report.asp
<meta content= "text/html; Charset=big5 "http-equiv=" Content-type ">
<title>client use RDS produce Excel report</title>
<body bgcolor= "Skyblue" topmargin=0 leftmargin= "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" >
<font color= "#000080" size= "3" >
Client use RDS produce Excel
</font>
</td>
</tr>
</table>
</div>
<div align= "Left" >
<input type= "button" value= "Query Data" name= "Query" language= "VBScript" style= "HEIGHT:32PX; width:90px ">
<input type= "button" value= "Clear Data" name= "clear" "language=" VBScript "style=" HEIGHT:32PX; width:90px ">
<input type= "button" value= "Excel", "name=", "language=" VBScript "style=" HEIGHT:32PX; width:90px ">
</div>
<div id= "AddData" ></div>
</form></center>
</body>
<script language= "VBScript" >
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
MsgBox "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 ' header number to print in one page!
Titlerowcnt=3 ' 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 ' head and Title
Call Head_title
' Add ' Data
Do as 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 ' 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 ' 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 ' 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 & _
"Titlerowcnt=" & titlerowcnt & "" & vbcr & _
"Contentrowcnt=" & contentrowcnt & "" & vbcr & _
"Footrowcnt=" & footrowcnt & "" & vbcr & _
"Pagerowcnt=headrowcnt+titlerowcnt+contentrowcnt+footrowcnt" & vbcr & _
"Bgncnt=1" & vbcr & _
"Pageno=1" & vbcr & _
"Range (" "A" "+trim (bgncnt) +" ":D" +trim (bgncnt)). Select "& vbcr & _
"With Sheet1" & vbcr & _
" . Range ("A1"). ColumnWidth = "& columnawidth&" "& vbcr & _
" . Range ("B1"). ColumnWidth = "& columnbwidth&" "& vbcr & _
" . Range ("C1"). ColumnWidth = "& columncwidth&" "& vbcr & _
" . Range ("D1"). ColumnWidth = "& columndwidth&" "& vbcr & _
"End With" & vbcr & _
"Do While pageno<=" & totalpagecnt& "" & vbcr & _
"If pageno=" & totalpagecnt& "then" & vbcr & _
"Contentrowcnt=" & contentrownowcnt & "" & vbcr & _
"Pagerowcnt=headrowcnt+titlerowcnt+contentrowcnt+footrowcnt" & vbcr & _
"End If" & vbcr & _
"Range (" "A" "+trim (bgncnt) +" ":D" +trim (bgncnt+pagerowcnt-1)). Select "& vbcr & _
"With Range" ("A" "+trim (bgncnt) +" ":D" "+trim (bgncnt+pagerowcnt-1)" & vbcr & _
" . Borders.LineStyle = xlcontnuous "& vbcr & _
" . Borders.Weight = Xlthin "& vbcr & _
" . Borders.colorindex = "& vbcr & _
" . RowHeight = "& vbcr & _
" . VerticalAlignment = Xlcenter "& vbcr & _
" . HorizontalAlignment = Xlleft "& vbcr & _
" . Font.Size = 9 "& vbcr & _
"End With" & vbcr & _
"With Range" ("A" "+trim (bgncnt) +" ":D" "+trim (bgncnt+headrowcnt-1)" & vbcr & _
" . Font.Size = one "& vbcr & _
" . Font.Bold = True "& vbcr & _
" . Borders.LineStyle = Xllinestylenone "& vbcr & _
" . VerticalAlignment = Xlcenter "& vbcr & _
" . HorizontalAlignment = Xlcenter "& vbcr & _
" . Orientation = xlhorizontal "& vbcr & _
"End With" & vbcr & _
"With Range" ("A" "+trim (bgncnt+headrowcnt) +" ":D" "+trim (bgncnt+headrowcnt+titlerowcnt-1)" & vbcr & _
" . WrapText = True "& vbcr & _
" . Font.Size = 9 "& vbcr & _
" . Font.Bold = True "& vbcr & _
" . VerticalAlignment = Xlcenter "& vbcr & _
" . HorizontalAlignment = Xlcenter "& vbcr & _
" . Orientation = xlhorizontal "& vbcr & _
"End With" & vbcr & _
"With Range" ("A" "+trim" bgncnt+headrowcnt+titlerowcnt+contentrowcnt) + ":D" +trim (bgncnt+headrowcnt+titlerowcnt+ contentrowcnt+footrowcnt-1)) "& vbcr & _
" . Font.Size = 9 "& vbcr & _
" . Font.Bold = True "& vbcr & _
" . Borders.LineStyle = Xllinestylenone "& vbcr & _
" . VerticalAlignment = Xlcenter "& vbcr & _
" . HorizontalAlignment = Xlleft "& vbcr & _
" . Orientation = xlhorizontal "& vbcr & _
"End With" & vbcr & _
"Pageno=pageno+1" & vbcr & _
"Bgncnt=bgncnt+pagerowcnt" & vbcr & _
"Loop" & vbcr & _
"With Sheet1.pagesetup" & vbcr & _
" . HeaderMargin = Application. CentimetersToPoints (0) "& vbcr & _
" . LeftMargin = Application. CentimetersToPoints (2) "& vbcr & _
" . RightMargin =application. CentimetersToPoints (2) "& vbcr & _
" . TopMargin = Application. CentimetersToPoints (1) "& vbcr & _
" . BottomMargin = Application. CentimetersToPoints (1) "& vbcr & _
" . FooterMargin = Application. CentimetersToPoints (0) "& vbcr & _
"' . Orientation = Xllandscape "& vbcr & _
" . Orientation = xlportrait "& vbcr & _
" . centerhorizontally = True "& vbcr & _
" . centervertically = False "& vbcr & _
" . PaperSize = xlPaperA4 "& vbcr & _
"End With" & vbcr & _
"Range (" "A1"). Select "& vbcr & _
"End Sub"
Xlmodule. Codemodule.addfromstring (Strcode)
Xlapp.run "MyMacro"
End Sub
</script>
