机房收费系统——导出Excel

最新推荐文章于 2019-10-27 21:04:51 发布

呀呼嘿—yara

最新推荐文章于 2019-10-27 21:04:51 发布

阅读量592

点赞数

分类专栏：机房收费系统

本文链接：https://blog.csdn.net/YaraRen/article/details/86708565

版权

机房收费系统专栏收录该内容

10 篇文章 1 订阅

订阅专栏

机房中有几个窗体用到了导出Excel这个功能，所以今天写一个博客总结一下这个知识点。
第一步，在引用中添加Excel，如图：
在这里插入图片描述
第二步，编辑代码（以收取金额查询为例）
1）问：考虑是否有查询结果，如果没有查询结果如何停止导出。
答：设置文本框提示“数据为空”，并中止进程
2）问：导出的过程中，怎样防止多次导出相同表。
答：导出成功后即清空数据，再次点击就会提示“数据为空”，中止进程。
3）具体代码展示如下：

    Dim i As Long, j As Long
    Dim CellsData() As String
    Dim objApp As Excel.Application
    Dim objWorkbook As Excel.Workbook
    Dim objWorksheet As Excel.Worksheet
    Dim objRange As Excel.Range
    
    '构造二维数组
    ReDim CellsData(1 To Me.MSFlexGrid1.Rows, 1 To Me.MSFlexGrid1.Cols)
    For i = 1 To Me.MSFlexGrid1.Rows
        For j = 1 To Me.MSFlexGrid1.Cols
            CellsData(i, j) = Me.MSFlexGrid1.TextMatrix(i - 1, j - 1)
        Next
    Next

    If MSFlexGrid1.Text = "" Then
        MsgBox "没有数据！", 0 + 48, "警告"
        Exit Sub
    Else
        '导出到Excel中
        Set objApp = New Excel.Application
        objApp.ScreenUpdating = False '禁止屏幕刷新
        Set objWorkbook = objApp.Workbooks.Add
        Set objWorksheet = objWorkbook.Sheets.Add
        Set objRange = objWorksheet.Range(objWorksheet.Cells(1, 1), objWorksheet.Cells(Me.MSFlexGrid1.Rows, Me.MSFlexGrid1.Cols))
        objRange.Value = CellsData
        objApp.Visible = True
        objApp.ScreenUpdating = True
        
        '销毁二维数据
        Erase CellsData
        
        Me.SetFocus
        MsgBox "导出成功！", 0 + 48, "提示"
        MSFlexGrid1.Clear
    End If

博文分享到这里，就可以实现Excel顺利导出了。