机房收费系统————导出到Excel

全栈程序员-用户IM • 2022年4月24日下午8:20 • 未分类

大家好，又见面了，我是你们的朋友全栈君。

机房收费系统中有很多之前在敲学生的时候没有接触到的功能，遇到的第一个陌生的就是把数据导出到Excel中，那么这个功能是怎么实现的呢？

首先，在VB中“工程”——>”引用”中添加引用

机房收费系统————导出到Excel

如果没有这个选项，单击右边的浏览，找到路径：c:\ Program Files \ Microsoft Office \ Office 15 下的 EXCEL.exe 添加就可以了。（这个方法可能会因为电脑的不同有所差异，不一样的话自己研究一下就好了，总之就是要添加引用）

机房收费系统————导出到Excel

接下来就是通过代码实现功能，大体上有两种实现方法

法一：数据从VB控件 MSHFlexGrid 中导出

Private Sub cmdExport_Click()
    Dim i As Integer
    Dim j As Integer
    
    On Error Resume Next
    If myflexgrid.TextMatrix(1, 0) = "" Then
        MsgBox "没有数据导出", vbInformation, "提示"
        Exit Sub
    End If
    
    Dim excelApp As Excel.Application
    Set excelApp = New Excel.Application
    Set excelApp = CreateObject("excel.application")
    Dim exbook As Excel.Workbook
    Dim exsheet As Excel.Worksheet
    Set exbook = excelApp.Workbooks.Add
    
    excelApp.SheetsInNewWorkbook = 1
    excelApp.Visible = True
    Me.MousePointer = vbHourglass
    
    With excelApp.ActiveSheet
        For i = 1 To myflexgrid.Rows
            For j = 1 To myflexgrid.Cols
                .Cells(i, j).Value = "" & Format$(myflexgrid.TextMatrix(i - 1, j - 1))
            Next j
        Next i
    End With
    
    Me.MousePointer = 0
    Set exsheet = Nothing
    Set exbook = Nothing
    Set excelApp = Nothing
    
End Sub

法二：数据从SQL Server数据库的记录中导出

Private Sub cmdExport_Click()

    Dim i As Integer
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    Dim x1app1 As Excel.Application
    Dim x1book1 As Excel.Workbook
    Dim x1sheet1 As Excel.Worksheet
    
    Set x1app1 = CreateObject("excel.application")
    Set x1book1 = x1app1.Workbooks.Add
    Set x1sheet1 = x1book1.Worksheets(1)
    
    txtSQL = "select cardNo,Date,time,CancelCash,UserID,status from CancelCard_Info where date between '" & Trim(DTPicker1.Value) & "' and '" & Trim(DTPicker2.Value) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    For i = 0 To mrc.Fields.Count - 1
        x1sheet1.Cells(1, i + 1) = mrc.Fields(i).Name
    Next i
    
    If Not mrc.EOF Then
        mrc.MoveFirst
        x1sheet1.Range("A2").CopyFromRecordset mrc
        mrc.Close
    End If
    Set mrc = Nothing
    x1app1.Visible = True
    Set x1app1 = Nothing