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 SubOption 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 ExplicitPublic 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
本文已收录于以下专栏：
相关文章推荐
使用vb将excel导入PowerDesigner，生成表结构
'介绍：采用Aspose导出EXCEL
    '导出数据到EXCEL文件
    '-------------------------------------------------------...
1.VB操作EXCEL2003
[vb] view
‘*************************************...
首先,须在项目里引用: 添加引用Microsoft.Office.Interop.Excel
Imports Excel = Microsoft.Office.Interop.Excel
Excel启用vb编辑，要在选项中自定义功能区把开发工具加上。
上次简单使用vb处理一些excel数据，现学了一下。把代码存着，以后备用。' 定义按钮点击事件
Private Sub Command...
全面控制 Excel 
首先创建 Excel 对象，使用ComObj: 
Dim ExcelID as Excel.Application 
Set ExcelID as new Excel.A...
他的最新文章
讲师：王哲涵
讲师：韦玮
您举报文章：
举报原因：
原文地址：
原因补充：
(最多只允许输入30个字)vb6.0控制excel进行报表设计及打印_中华文本库
巧用VB调用Excel实现复杂报表设计与打印_IT/计算机_专业资料。巧用 VB 调用 Excel实现复杂报表设计与打印畅育超 摘 要: 以 “人事档案管理数据库” 为例, 介绍...
VB6.0下运用Excel实现通用打印_专业资料。针对VB开发管理信系统过程中遇到的报表处理问题,介绍了结合Excel进行报表制作的方法。维普资讯
操作,也能够关闭 EXCEL,同时也可对 EXCEL 进行操作...本文结合自己的实践和体会,谈谈如何在 VB6.0 应用...阐述基于 VB 和 EXCEL 的报表设计及 打印过程。 1...
VB控制EXCEL进行报表设计及打印_机械/仪表_工程科技_专业资料。VB控制EXCEL进行报表...4)具体实例 下面给出一个具体实例,它在 window2000、Visual Basic 6.0、...
vb导出excel报表_计算机软件及应用_IT/计算机_专业资料...操作,也能够关闭 EXCEL,同时也可对 EXCEL 进行操作...用VB操作Excel(VB6.0)(整... 9页 免费 用VB操作...
本文结合自己的实践和体会,谈 谈如何在 VB6.0 应用...如果为 True 则 Excel 打印指定对象之前进行打印...具体的表格画线可以由 Excel 自动完成,因此简化了 ...
用VB操作Excel(VB6.0)(整理)_IT/计算机_专业资料。基于VB6.0的excel操作技巧整理...进行页面设置: a.页眉: ExcelID.ActiveSheet.PageSetup.CenterHeader:='报表...
objExcelFile = Nothing 基于 VB 和 EXCEL 的报表设计及打印 在现代管理信息...4)具体实例 下面给出一个具体实例,它在 window98、Visual Basic6.0、Microsoft ...
vb6.0 如何操作 excel (该内容为网上网友提问,网友解答) vb 如何对 excel 表格进行操作,如对单元格插入内容 清除、修改单元格内容 打印表格内容 问题补充: 问题...
用VB操作Excel(VB6.0)(整理)_计算机硬件及网络_IT/计算机_专业资料。整理) 用...进行页面设置: a.页眉: ExcelID.ActiveSheet.PageSetup.CenterHeader:='报表...}