机房收费系统之导出为Excel

在学生信息管理系统中，有很多查询窗体。在机房收费系统中，也不例外。不过，前者只要求将数据显示在窗体中，后者则多了一步，即：将查询到的信息导出为Excel表的形式。

这样的工作好熟悉，因为在作品展中试过很多次了。那时候，还没有学数据库，师父就让我们用Excel表来存储数据，以显示出来。所以，做起来还是比较得心应手的。

第一个窗体，学生查看上机记录，没有多想，就直接在导出为Excel命令下编写代码：

<span style="font-family:KaiTi_GB2312;font-size:24px;">Private Sub cmdExcel_Click()

    '直接创建程序导出到Excel表中
    
    Dim xlsApp As New Excel.Application    '定义Excel程序
    Dim xlsBook As Excel.Workbook          '定义工作簿
    Dim xlsSheet As Excel.Worksheet        '定义工作表
    
    Dim i As Integer                       '定义控件的行值
    Dim j As Integer                       '定义控件的列值
    
    If FlexOnlineRecord.Text = "" Then     '判断控件是否有内容
        MsgBox "没有记录可导出！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
        Set xlsBook = xlsApp.Workbooks.Add(1)            '创建新的工作簿
        Set xlsSheet = Excel.ActiveWorkbook.ActiveSheet  '创建新的工作表单
        
        For i = 0 To FlexOnlineRecord.Rows - 1           '显示数据
            For j = 0 To FlexOnlineRecord.Cols - 1
            xlsSheet.Cells(i + 1, j + 1) = FlexOnlineRecord.TextMatrix(i, j)
            Next j
        Next i
        
        xlsApp.Visible = True              '显示Excel表格
        'Set xlsApp = Nothing '交还控制给Excel
        xlsApp.Sheets(1).Columns.EntireColumn.AutoFit '自动调整列宽
    End If
    
End Sub</span>

<span style="font-family:KaiTi_GB2312;font-size:24px;">Public Sub ExportToExcel(FormName As Form, flex As MSFlexGrid)   </span>

<span style="font-family:KaiTi_GB2312;font-size:24px;">    '导出为Excel表的过程，前者为当前工作的窗体名，后者为控件名。
    
    Dim xlsApp As Object
    Dim xlsBook As Object
    Dim xlsSheet As Object
    
    Screen.MousePointer = vbHourglass
    
    Set xlsApp = New Excel.Application
    Set xlsBook = xlsApp.Workbooks.Add
    Set xlsSheet = xlsBook.Worksheets(1)
    
    On Error GoTo Err_proc
    
    Dim i As Integer
    Dim j As Integer
    
    With flex                           '将数据写入Excel表中
        For i = 0 To .Rows - 1
            For j = 0 To .Cols - 1
                xlsSheet.Cells(i + 1, j + 1).Value = "'" & .TextMatrix(i, j)
                
            Next j
        Next i
    End With
    
    xlsApp.Sheets(1).Columns.EntireColumn.AutoFit '自动调整列宽
    xlsApp.Visible = True
    Screen.MousePointer = vbDefault
    Exit Sub
    
Err_proc:

    Screen.MousePointer = vbDefault
    MsgBox "请确认您的电脑已安装Excel，或是否安装正确！", vbExclamation, "机房收费系统"

End Sub
</span>

<span style="font-family:KaiTi_GB2312;font-size:24px;">Private Sub cmdExcel_Click()

    Call ExportToExcel(frmInquireRechargeRecord, MSFlexRechargeRecord)              ’调用导出为Excel表过程
    
End Sub</span>