深圳升蓝软件
数据库开发  |  .Net技术  |  ASP技术  |  PHP技术  |  JSP技术  |  应用技术类   
Hiblue Software

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

March 25,2004
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=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    '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 & _
"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>

       
Copyright © 2001-2008 Shenzhen Hiblue Software Team All rights reserved