机房优化(导出Excel篇)

在上周与师父的机房第一遍验收中发现了很多没有注意到的小问题。其中师父点出了我的导出Excel的不足，并给我提出了建议。于是经过了大量的尝试我找到了三种导出Excel的方法。

方法一

这种方法是我最开始使用的方法

private cmdoutfile_click（）
    Dim ExcelApp As excel.Application
    Dim ExcelBook As excel.Workbook
    Dim ExcelSheet As excel.Worksheet
    Dim ExcelRange As excel.Range
    Dim i, j As Integer

    Set ExcelApp = CreateObject("Excel.Application")            '创建excel应用程序对象
    Set ExcelBook = ExcelApp.Workbooks.Add                      '创建一个工作簿
    Set ExcelSheet = ExcelBook.Worksheets(1)                    '创建一个工作表
    DoEvents                                                    '转让控制权，以便让操作系统处理其他的事件
    With MSFlexGrid1                                             '将FLEXGRID控件中的内容导入excel表格
        For i = 0 To .Rows - 1                              '遍历所有的行
            For j = 0 To .Cols - 1                               '遍历所有的列
                DoEvents                                        '转让控制权，以便让操作系统处理其他的事件
                ExcelApp.ActiveSheet.Cells(i + 1, j + 1) = .TextMatrix(i, j) '创建新的单元格，并添加flexgrid的内容
            Next j
        Next i
    End With
    ExcelApp.ActiveWorkbook.SaveAs App.Path & "\充值查询.xls"      '表格保存路径
    ExcelApp.ActiveWorkbook.Saved = True                           '保存表格
    MsgBox "导出完成！", vbOKOnly + vbExclamation, "提示"          '保存成功提示
    ExcelApp.Visible = True   
end sub

方法二

这种方法是我最终采用的方法

private sub cmdoutfile_click（）
	Dim j As Integer  ' 定义控件的行值
	Dim i As Integer  ' 定义控件的列值
	Dim xlApp As Excel.Application         '定义excel程序
    	Dim xlBook As Excel.Workbook          '定义工作表
    	Dim xlsheet As Excel.Worksheet              '定义工作表
    	If MSFlexGrid1.TextMatrix(Row, Col) = "" Then             '判断是否有数据可以导出
        MsgBox "当前没有记录可导出！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        MSFlexGrid1.Redraw = False             '关闭表格
        
        Set xlApp = CreateObject("excel.application")                   '对象实例化
        xlApp.Visible = True                                            '对象可见
        Set xlBook = xlApp.Workbooks.Open(App.Path & "\充值查询记录.xlsx")
        Set xlsheet = xlBook.Worksheets(1)             '实例化表单
            For i = 0 To MSFlexGrid1.Rows - 1
                For j = 0 To MSFlexGrid1.Cols - 1
                    MSFlexGrid1.Row = i
                    MSFlexGrid1.Col = j
                    xlBook.Worksheets("sheet1").Cells(i + 1, j + 1) = MSFlexGrid1.Text
                Next j
            Next i
        MSFlexGrid1.Redraw = True
    End If
    end sub

通过这种方法可以打开Excel操作界面借助Excel本身让使用者自己决定存储路径。

方法三

Public Function ExportToExcel(myflexgrid As MSFlexGrid)
    On Error GoTo errormsg
    Dim xlApp As excel.Application
    Dim xlbook As excel.Workbook
    Dim rows As Integer
    Dim cols As Integer
    Dim irow As Integer
    Dim hcol As Integer
    Dim icol As Integer
    
    If myflexgrid.rows <= 1 Then                        '判断有无数据
        MsgBox "没有数据", vbInformation, "提示"
        Exit Function
    Else
        Set xlApp = CreateObject("Excel.Application")
        Set xlbook = xlApp.Workbook.Add
        xlApp.Visible = True
        
        With myflexgrid
            rows = .rows
            cols = .cols
            irow = 0
            icol = 1
            For hcol = 0 To cols - 1
                For irow = 1 To rows
                    xlApp.Cells(irow, icol).Value = .TextMatrix(irow - 1, hcol)
                Next irow
            Next hcol
        End With
        
        With xlApp
            .rows(1).Font.Bold = True
            .Cells.Select
            .Columns.AutoFit
            .Cells(1, 1).Select
        End With
        
        xlApp.DisplayAlerts = False
        Set xlApp = Nothing
        Set xlbook = Nothing
        Exit Function
        
    End If
errormsg:
    MsgBox "当前无法导出Excel", vbOKOnly + vbExclamation, "提示"
End Function

这种方法非常方便，在模块中写好，需要时直接调用。但是因为我的office版本问题最终弃用了，在第二次机房时会尝试成功运用。