VB中使用EXCEL输出

最新推荐文章于 2020-12-14 16:01:07 发布
最新推荐文章于 2020-12-14 16:01:07 发布
阅读量1.1k 收藏 1
点赞数
文章标签： excel vb integer security 工作 数据库

Private Sub cmdSwatch_Click()
Dim xls As excel.Application
Dim xlbook As excel.Workbook
'On Error GoTo exlError
Dim 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 Explicit
Public 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 = Nothing
End 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 = Nothing
End Sub


浩方软件HFWMS
关注
vb导出excell控件
05-12
利用vb中任意显示的表格，将表格中的数据导出为excell格式，简单方便，只需要一句话即可完成 例如vb中有一个ReportGrid1控件，已经加载完数据，则可以利用 Dim Cexcel As New ExcelOut.CExcelOut Cexcel.ExcelOut ReportGrid1 将数据导出
用vb操作EXCEL打印报表
OFFLINE2018的博客
02-10 291
最近使用vb来打印报表,打印出来的EXCEL一直无法上传到ftp 反复多次问题都没解决, 200 PORT command successful. Consider using PASV. 问题出在这,由于win10的防火墙的原因,关闭防火墙后问题得到解决. 转载于:https://www.cnblogs.com/Shum1n/p/6385044.html...
VB输出数据到EXCEL
weixin_34293141的博客
07-21 777
Private Sub Command1_Click() Dim i As Long Dim j As Long Dim myData(10, 10) As Long Dim xlApp, WS, WB Set xlApp = CreateObject("Excel.Application") Set WB = xlApp.WorkB...
vb操作excel 打印
zxs820329的专栏
07-09 1634
Sub Macro1() With ActiveSheet.PageSetup This is the first part. .PrintTitleRows = "" .PrintTitleColumns = "" End With ActiveSheet.PageSetup
VB导出excel的三种方法
09-04
VB6导出到Excel的三种方法全部编译通过，可以放心下载，文字描述较少，基本都是代码。
VB制作Excel报表并自动汇总输出
05-07
摘要:VB源码,系统相关,Excel报表　VB制作Excel报表并自动汇总输出，使用Excel制作报表的范例，几乎都是单纯地把数据输出到Excel，对有多年Excel使用经验的人来说，一点也不切合实际，可以归类为『为技术而技术』。...
vb.net将excel中的数据导入到数据库
05-07
本篇文章将详细介绍如何使用VB.NET实现将Excel文件中的数据导入到SQL Server数据库的过程，并对代码进行逐行解析，帮助读者更好地理解和掌握这一技术。 #### 1. 连接Excel文件 首先，我们需要建立与Excel文件的...
用vb语言输出excel并设置自动调整各列宽度
11-14
用vb语言输出excel并设置自动调整各列宽度
VB导出excel可用控件
06-03
VB导出excel可用控件，非常好用，亲测可用。
VB调用Excel方法及打印案例
09-11
VB调用Excel详细方法及在VB中打印Excel的案例
vb表格控件
06-15
vb表格控件， 很详细
VB调用Excel软件实现打印预览功能
05-12
摘要:VB源码,报表打印,打印预览　　VB调用Excel软件实现打印预览功能，可以插入折线图，VB打印预览功能示例源码，分享给大家参考。
用VB制作EXCEL插件
03-23
如果你想将EXCEl内的VBA封装成DLL文件，可看这里啊
vb 用excel打印
zxs820329的专栏
07-09 1734
Dim xlApp As Excel.Application 定义EXCEL类Dim xlBook As Excel.Workbook 定义工件簿类Dim xlsheet As Excel.Worksheet 定义工作表类Set xlApp = CreateObject("Excel.Application") 创建EXCEL应用类xlApp.Visible = True
VB代码实现导出为Excel
SoalChess的博客
03-25 1217
需要安装Microsoft.Office.Interop.Excel 前期网上寻找并修改为可用的方法 VB代码实现导出为Excel Private Function ToExcel(excelTalbe As DataTable, filePath As String, fileName As String) As Boolean Dim app As New Micros...
vb excel编程实例_VB常用控件的名称与简写总结
weixin_39980353的博客
12-14 972
大家好，在VB软件的工具箱中，有20个标准控件，可以说把这些控件领悟贯通，VB基础部分才算真正掌握。图：VB工具箱中的控件及名称图：VB常用控件的名称及简写前缀学习VB中有遇到问题，可长按识别下图添加老师微信号，学习中的问题在线答疑。周末福利VB是世界上使用人数最多的编程语言之一，广泛应用在我们工作和社会生产活动的方方面面。在当今信息技术日新月异的时代，编程语言的学习更是对自己的综合能力...
vb仿excel控件_Excel | 一种另类但大有用途的下拉菜单
weixin_39979245的博客
12-14 772
每天清晨，准时相约问题情境昨天的Excel | 下拉菜单的三种做法中讲述的是常规下拉菜单的实现方法，今天介绍一种非常规的做法——”控件法“。想要用”控件“法，必须先找到”控件“在哪里：”控件“隐藏是开发工具中。如果只做一些数据的简单统计，不需要用到开发工具，如果要做一些”开发“性的数据统计与分析，如动态图表、宏、VB，那就有必要将”开发工具“菜单显示出来，以方便使用。显示”开发工具“菜单...
VB通过EXCEL输出数据：创建与管理电子表格
代码中使用两个For循环，分别处理Check2和Check3控件的勾选状态。Check2和Check3可能是用户界面中的复选框，用于选择要导出的数据类型。当某个复选框被选中时，对应的子程序（如`ToExcelJDanJiaSum....
评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值