注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

汇总技巧

你快乐我快乐.... 汇集各类技巧,传播技巧,让我们共同熟练运用技巧..

 
 
 

日志

 
 

客户端用ASP+rds+VBA参生报表(高级篇)  

2011-06-07 13:40:54|  分类: ◆ASP技巧 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
 

   test_print_report.asp
html
head
meta content=text/html; charset=BIG5 http-equiv=Content-Type
titleclient 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=centercenter
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,ColumnDWidt
sub fun_query()
set rds = CreateObject(RDS.DataSpace)
Set df = rds.CreateObject(RDSServer.DataFactory,http://iscs00074
target=_blank>http://iscs00074">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=1trtdjob_id/tdtdjob_desc/tdtdmax_lvl/tdtdmin_lvl/td/trtrtd+ rs.GetString(,,/tdtd,/td/trtrtd, ) +/td/tr/table
adddata.innerHTML=StrRs
StrRs=
else
msgbox No data in the table!
end i
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
target=_blank>http://iscs00074">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 Widt!
ColumnBWidth=30 'The ColumnB Widt!
ColumnCWidth=5 'The ColumnC Widt!
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 wit
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 i
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 wit
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 wit
'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 Wit
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 wit
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 wit
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 = 10  vbCr  _
 .RowHeight = 15  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 = 11  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

  评论这张
 
阅读(247)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017