机房收费系统-导出excel

Private Sub Command5_Click()
    Dim xlsapp As Excel.Application                 '定义excel程序
    Dim xlsbook As Excel.Workbook                   '定义工作簿
    Dim xlssheet As Excel.Worksheet                 '定义工作表
    Dim j As Long
    Dim i As Long
    Set xlsapp = CreateObject("excel.application")  '创建应用程序
    Set xlsbook = xlsapp.Workbooks.Add
    Set xlssheet = xlsbook.Worksheets(1)            '设置应用表
    With xlsapp
         .Rows(1).Font.Bold = True                  '设置字体格式
    End With
    For i = 0 To MSFlexGrid1.Rows - 1               '把msflexgrid1的内容写入到电子表格中
        For j = 0 To MSFlexGrid1.Cols - 1
            xlssheet.Cells(i + 1, j + 1) = "'" & MSFlexGrid1.TextMatrix(i, j)
        Next j
    Next i
    xlsapp.Visible = True

End Sub

这是在敲学生信息维护的窗体时用的窗体,这个代码的好处就是没有太多的代码,还有一点就是他不会出现重复导出时出现错误,之前的代码因为存在保存的功能,在重复导出时取消会出现错误,而这个和它相比就是没有保存的功能,但是如果没有太多直接不必要的功能代码出现错误的概率就会小很多,下面是之前的代码,还请大神给分析他们两个不同与思路。

Private Sub cmdexportexcel_Click()
    Dim Excelapp As Excel.Application
    Dim Excelbook As Excel.Workbook
    Dim Excelsheet As Excel.Worksheet
    Dim ExcelRange As Excel.Range
    
    
    Dim i As Integer
    Dim j As Integer
    
    
    Set Excelapp = CreateObject("Excel.application") '创建一个excel应用程序对象
    Set Excelbook = Excelapp.Workbooks.Add '创建一个工作簿
    Set Excelsheet = Excelbook.Worksheets(1) '创建一个工作簿
    
    
    DoEvents
    '因以下代码运行时间较长,所以转让控制权,让操作系统处理其他事件,避免操作不响应误认为死机
    
    
    If MSFlexGrid1.Rows <= 1 Then
        MsgBox "没有可导出数据!", vbOKOnly, "温馨提示:"
    End If
    
    
    With MSFlexGrid1
        For i = 0 To .Rows - 1  '循环添加行内容
            For j = 0 To .Cols - 1  '循环添加列内容
            DoEvents
            Excelapp.ActiveSheet.Cells(i + 1, j + 1) = .TextMatrix(i, j) '添加单元格内容
            Next j
        Next i
    End With
    
    
    Excelapp.ActiveWorkbook.SaveAs App.Path & "\学生上机查询.xls"  '设置excel保存路径
    Excelapp.ActiveWorkbook.Saved = True '保存excel表格
    MsgBox "导出成功!", vbOKOnly, "温馨提示:"
    Excelapp.Visible = True '显示表格
    
    
    Set Excelapp = Nothing
    Set Excelbook = Nothing
    Set Excelsheet = Nothing
    
    
End Sub

感谢各位的分享与意见。

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 4
    评论
评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

皮卡冲撞

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值