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
.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
设为主页
收藏本站
相关文章: