设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 738|回复: 0
打印 上一主题 下一主题

[报表] 客户端用ASP+rds+VBA参生报表(高级篇)[转帖程序员之家收费会员]

[复制链接]
跳转到指定楼层
1#
发表于 2002-9-21 01:27:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
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">
<font color="#000080" size="3">
client use rds produce excel report
</font>
</td>
</tr>
</table>
</div>
<div align="left">
<input type="button" value="Query Data" name="query" language="vbscript" onclick="fun_query()" style="HEIGHT: 32px; WIDTH: 90px">
<input type="button" value="Clear Data" name="Clear" language="vbscript" onclick="fun_clear()" style="HEIGHT: 32px; WIDTH: 90px">
<input type="button" value="Excel Report" name="report" language="vbscript" onclick="fun_excel()" style="HEIGHT: 32px; WIDTH: 90px">
</div>
<div id="adddata"></div>
</form></center>
</body>
</html>
<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=saASSWORD=;"
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=saASSWORD=;"
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
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-10 11:47 , Processed in 0.083995 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表