VB中使用EXCEL输出

 private sub cmdswatch_click()dim xls as excel.applicationdim xlbook as excel.workbook'on error goto exlerrordim i as integer    if dir(text1.text) <> "" then '此目次下如有同名文献给出提醒,并作相映处置        if msgbox("文献已生存，能否掩盖！", vbyesno + vbquestion, "另存为工程造价文献") = vbno then            exit sub        else            kill (text1.text) '简略文献        end if    end if

    '************打动工作表***************    set xls = new excel.application    xls.visible = true    set xlbook = xls.workbooks.add    '*********************************    for i = 0 to 14        if check2(i).value = vbchecked then            select case i                case 8                    toexceljdanjiasum.toexceljdanjiasum xlbook, xls                case 9                    toexceladanjiasum.toexceladanjiasum xlbook, xls                case 10                    toexcelcailiao.toexcelcailiao xlbook, xls                case 11                    toexceltsf.toexceltsf xlbook, xls                case 12                    toexcelzgcl.toexcelzgcl xlbook, xls            end select        end if    next    for i = 0 to 6        if check3(i).value = vbchecked then            select case i                case 0                    toexcelman.toexcelman xlbook, xls                case 1                    toexcelfsd_cl.toexcelfsd_cl xlbook, xls                case 2                    toexcelhnt.toexcelhnt xlbook, xls                case 3                    toexcelzsf.toexcelzsf xlbook, xls                case 4                    toexceljingchang.toexceljingchang xlbook, xls                case 5                    toexceljdanjia.toexceljdanjia xlbook, xls                case 6                    toexceladanjia.toexceladanjia xlbook, xls            end select        end if    next        xlbook.saveas text1.text '生存excel文献    '***************************封闭excel东西*******************    if check1.value = vbchecked then        xlbook.close        xls.quit    end if    set xlbook = nothing    set xls = nothing    exit sub'exlerror:   ' msgbox err.description, vbokonly + vbcritical, "劝告"end sub

option explicitpublic sub toexcelzgcl(byref xlbook, byref xls) '输入总工程师程量    dim con as new adodb.connection    dim rst_gcl as new adodb.recordset    dim rst_qm as new adodb.recordset    '**************************贯穿数据库****************************************    con.cursorlocation = aduseclient    con.connectionstring = "provider=microsoft.jet.oledb.4.0;data source=" & strconnection & ";persist security info=false"    con.open    rst_gcl.open "zonggcl", con, adopenkeyset, adlockoptimistic, adcmdtable '打动工程量汇总表    if not (rst_gcl.bof and rst_gcl.eof) then        rst_gcl.movefirst    end if    rst_qm.open "qianming", con, adopenkeyset, adlockoptimistic, adcmdtable '翻开出面表    rst_qm.movefirst    '****************************处事表初使化***********************************    dim xlsheet as excel.worksheet    set xlsheet = xlbook.sheets.add '增添一张处事表    xlsheet.name = "工程量汇总"    xls.activesheet.pagesetup.orientation = xllandscape '纸张树立为横向    xlsheet.columns("a:j").font.size = 10    xlsheet.columns("a:j").verticalalignment = xlvaligncenter  '笔直居中    xlsheet.columns(1).horizontalalignment = xlhaligncenter '1列程度居中对齐    xlsheet.columns(1).columnwidth = 8    xlsheet.columns(2).horizontalalignment = xlhalignleft    xlsheet.columns(2).columnwidth = 26    xlsheet.columns("c:j").horizontalalignment = xlhalignright    xlsheet.columns("c:j").columnwidth = 10    xlsheet.columns("c:j").numberformatlocal = "0.00_ " '3到10列保持两位少量    '***************************写入标头*************************************    xlsheet.rows(1).rowheight = 40    xlsheet.range(xlsheet.cells(1, 1), xlsheet.cells(1, 10)).mergecells = true    xlsheet.cells(1, 1).value = "工程量汇总"    xlsheet.cells(1, 1).font.size = 14    xlsheet.cells(1, 1).font.bold = true        xlsheet.rows(2).rowheight = 18    xlsheet.rows(2).horizontalalignment = xlhaligncenter    xlsheet.cells(2, 1).value = "序号"    xlsheet.cells(2, 2).value = "工程名目及称呼"    xlsheet.cells(2, 3).value = "土方开挖(m3)"    xlsheet.cells(2, 4).value = "石方开挖(m3)"    xlsheet.cells(2, 5).value = "土方回填(m3)"    xlsheet.cells(2, 6).value = "洞挖石方(m3)"    xlsheet.cells(2, 7).value = "砼浇筑(m3)"    xlsheet.cells(2, 8).value = "钢骨制安(t)"    xlsheet.cells(2, 9).value = "砌石匠程(m3)"    xlsheet.cells(2, 10).value = "灌浆工程(m)"        xls.activesheet.pagesetup.printtitlerows = "$1:$2" '恒定表头    '***************************写入实质*************************    dim i as integer    i = 3 'i遏制行    dim j as integer 'j遏制列    dim countpage as integer    countpage = 0 '遏制页    do while not rst_gcl.eof        xlsheet.rows(i).rowheight = 18 '遏制行高        for j = 1 to 10            xlsheet.cells(i, j) = rst_gcl.fields(j) '将工程理库中的一条记载的第一个字段写入处事表中        next        '每18动作一页，即使数据胜过一页时举行特出处置        if i > 18 then            xls.activewindow.smallscroll down:=1 '震动窗口实质向下震动1行        end if        if i mod 18 = 0 then            if countpage = 0 then                xlsheet.range(xlsheet.cells(2, 1), xlsheet.cells(i, 10)).borders.linestyle = xlcontinuous '首页加边框            else                xlsheet.range(xlsheet.cells(23 + (countpage - 1) * 18, 1), xlsheet.cells(i, 10)).borders.linestyle = xlcontinuous '中央页加边框            end if            i = i + 2 '加一条空行                    '******************************在非尾页写入出面**************************************            xlsheet.range(xlsheet.cells(i, 1), xlsheet.cells(i, 10)).mergecells = true            xlsheet.cells(i, 1).value = space(64) & rst_qm.fields(0)            xlsheet.rows(i).rowheight = 30            i = i + 1 '换行            xlsheet.range(xlsheet.cells(i, 1), xlsheet.cells(i, 10)).mergecells = true            xlsheet.cells(i, 1).value = space(50) & rst_qm.fields(1)            xlsheet.rows(i).rowheight = 15            i = i + 1            xlsheet.range(xlsheet.cells(i, 1), xlsheet.cells(i, 10)).mergecells = true            xlsheet.cells(i, 1).value = space(55) & rst_qm.fields(2)            xlsheet.rows(i).rowheight = 30            '****************************************************************************                        xlsheet.hpagebreaks.add (xlsheet.rows(i + 1)) '增添分页符            countpage = countpage + 1 '换页        end if        i = i + 1        rst_gcl.movenext    loop        xlsheet.range(xlsheet.cells(23 + (countpage - 1) * 18, 1), xlsheet.cells(i - 1, 10)).borders.linestyle = xlcontinuous '尾页加边框        i = i + 1 '介入一空行        '*********************************在尾页加出面***************************************        xlsheet.range(xlsheet.cells(i, 1), xlsheet.cells(i, 10)).mergecells = true        xlsheet.cells(i, 1).value = space(64) & rst_qm.fields(0)        xlsheet.rows(i).rowheight = 30        i = i + 1 '换行        xlsheet.range(xlsheet.cells(i, 1), xlsheet.cells(i, 10)).mergecells = true        xlsheet.cells(i, 1).value = space(50) & rst_qm.fields(1)        xlsheet.rows(i).rowheight = 15        i = i + 1        xlsheet.range(xlsheet.cells(i, 1), xlsheet.cells(i, 10)).mergecells = true        xlsheet.cells(i, 1).value = space(55) & rst_qm.fields(2)        xlsheet.rows(i).rowheight = 30        '***********************************************************************************        xls.activewindow.view = xlpagebreakpreview '分页预览        xls.activewindow.zoom = 100        if con.state = adstateopen then        rst_gcl.close        rst_qm.close        set rst_gcl = nothing        set rst_qm = nothing        con.close        set con = nothing    end if    set xlsheet = nothingend sub

option explicit

public sub toexceltsf(byref xlbook, byref xls)    dim con as new adodb.connection    dim rst_tsf as new adodb.recordset    dim rst_qm as new adodb.recordset    '**********************************贯穿数据库************************    con.cursorlocation = aduseclient    con.connectionstring = "provider=microsoft.jet.oledb.4.0;data source=" & strconnection & ";persist security info=false"    con.open    rst_tsf.open "tdefeiyong", con, adopenkeyset, adlockoptimistic, adcmdtable    if not (rst_tsf.bof and rst_tsf.eof) then        rst_tsf.movefirst    end if    rst_qm.open "qianming", con, adopenkeyset, adlockoptimistic, adcmdtable    rst_qm.movefirst    '*********************************处事表初使化**********************************    dim xlsheet as excel.worksheet    set xlsheet = xlbook.sheets.add    xlsheet.name = "板滞台时、组时费汇总表"    xlsheet.columns(1).columnwidth = 5    xlsheet.columns(2).columnwidth = 20    xlsheet.columns(3).columnwidth = 7    xlsheet.columns(4).columnwidth = 7    xlsheet.columns(5).columnwidth = 7    xlsheet.columns(6).columnwidth = 7    xlsheet.columns(7).columnwidth = 7    xlsheet.columns(8).columnwidth = 7    xlsheet.columns(9).columnwidth = 7    xlsheet.columns("a:i").font.size = 9    xlsheet.columns("a:i").verticalalignment = xlvaligncenter  '笔直居中    xlsheet.columns(1).horizontalalignment = xlhaligncenter '1列程度居中对齐    xlsheet.columns(2).horizontalalignment = xlhalignleft '2列程度左对齐    '******************************写入标头************************************    xlsheet.rows(1).rowheight = 35    xlsheet.range(xlsheet.cells(1, 1), xlsheet.cells(1, 9)).mergecells = true    xlsheet.cells(1, 1).font.size = 14    xlsheet.cells(1, 1).font.bold = true    xlsheet.cells(1, 1).value = "板滞台时、组时费汇总表"        xlsheet.cells(2, 9).value = "单元：元"    xlsheet.range(xlsheet.cells(3, 1), xlsheet.cells(5, 1)).mergecells = true    xlsheet.cells(3, 1).value = "编号"    xlsheet.range(xlsheet.cells(3, 2), xlsheet.cells(5, 2)).mergecells = true    xlsheet.cells(3, 2).value = "板滞称呼"    xlsheet.range(xlsheet.cells(3, 3), xlsheet.cells(5, 3)).mergecells = true    xlsheet.cells(3, 3).value = "台时费"    xlsheet.range(xlsheet.cells(3, 4), xlsheet.cells(3, 9)).mergecells = true    xlsheet.cells(3, 4).value = "其      中"    xlsheet.range(xlsheet.cells(3, 3), xlsheet.cells(5, 3)).mergecells = true    xlsheet.cells(3, 3).value = "台时费"    xlsheet.range(xlsheet.cells(4, 4), xlsheet.cells(5, 4)).mergecells = true    xlsheet.cells(4, 4).value = "折旧费"    xlsheet.range(xlsheet.cells(4, 5), xlsheet.cells(5, 5)).mergecells = true    xlsheet.cells(4, 5).value = "补缀替代费"    xlsheet.range(xlsheet.cells(4, 6), xlsheet.cells(5, 6)).mergecells = true    xlsheet.cells(4, 6).value = "安拆费"    xlsheet.range(xlsheet.cells(4, 7), xlsheet.cells(5, 7)).mergecells = true    xlsheet.cells(4, 7).value = "人为费"    xlsheet.range(xlsheet.cells(4, 8), xlsheet.cells(5, 8)).mergecells = true    xlsheet.cells(4, 8).value = "燃料费"    xlsheet.range(xlsheet.cells(4, 9), xlsheet.cells(5, 9)).mergecells = true    xlsheet.cells(4, 9).value = "其余费"        xlsheet.range(xlsheet.cells(1, 1), xlsheet.cells(5, 9)).horizontalalignment = xlhaligncenter    xls.activesheet.pagesetup.printtitlerows = "$1:$5" '恒定表头    '****************************************写入实质*************************************    dim i as integer        i = 6    do while not rst_tsf.eof        xlsheet.cells(i, 1).value = rst_tsf.fields("nn")        xlsheet.cells(i, 2).value = rst_tsf.fields("name")        xlsheet.cells(i, 3).value = rst_tsf.fields("price")        xlsheet.cells(i, 4).value = rst_tsf.fields("zhejiu")        xlsheet.cells(i, 5).value = rst_tsf.fields("xiuli")        xlsheet.cells(i, 6).value = rst_tsf.fields("anchai")        xlsheet.cells(i, 7).value = rst_tsf.fields("rengong")        xlsheet.cells(i, 8).value = rst_tsf.fields("dongli")        xlsheet.cells(i, 9).value = rst_tsf.fields("qita")        if i > 22 then            xls.activewindow.smallscroll down:=1 '震动窗口实质向下震动1行        end if        i = i + 1        rst_tsf.movenext    loop    xlsheet.range(xlsheet.cells(6, 3), xlsheet.cells(i - 1, 9)).numberformatlocal = "0.00_ " '保持两位少量        '*********************************增添边框**********************************        xlsheet.range(xlsheet.cells(3, 1), xlsheet.cells(i - 1, 9)).borders.linestyle = xlcontinuous    '******************************************************************************    xls.activesheet.pagesetup.bottommargin = application.inchestopoints(2.2) '树立下侧面边距    xls.activesheet.pagesetup.footermargin = application.inchestopoints(1) '树立页脚高    xls.activesheet.pagesetup.centerfooter = "&10" & rst_qm.fields(0) & chr(10) & chr(10) & rst_qm.fields(1) & chr(10) & chr(10) & rst_qm.fields(2) '加页脚    xls.activewindow.view = xlpagebreakpreview '分页预览    xls.activewindow.zoom = 100    '***************************封闭记载集*******************    if con.state = adstateopen then        rst_tsf.close        rst_qm.close        set rst_tsf = nothing        set rst_qm = nothing        con.close        set con = nothing    end if    set xlsheet = nothingend sub