【数据库学习】机房收费系统（三）导出Excel

   前言

     机房收费系统中有一些和外界交互的突破，导出Excel就是一个明显的例子。Excel让机房收费系统的数据更加方便的导出，借用Excel更好地服务于人民。

   举例

     下面以收取金额查询的窗体为例，着重看看导出Excel的功能实现。

该窗体上只有两个button：查询和导出为excel。

     查询所要实现的功能，是将数据库表中相应的数据显示到MSHFlexgrid中。

     如下为参考代码：

     

Private Sub cmdInquire_Click()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
    '判断日期是否为空
    If Not Testtxt(DTPicker1.Value) Then
        MsgBox "请您选择开始日期！", 0 + 48, "提示"
        DTPicker1.SetFocus
    End If
    
    If Not Testtxt(DTPicker2.Value) Then
        MsgBox "请您选择截止日期！", 0 + 48, "提示"
        DTPicker2.SetFocus
    End If
    
    
    '起始时间不能比结束时间大
    If DTPicker1.Value > DTPicker2.Value Then
        MsgBox "终止日期不能小于起始日期！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    End If
    
    
    'sql语句
    txtSQL = "select * from ReCharge_Info where date between'" & Trim(DTPicker1.Value) & "' and '" & Trim(DTPicker2.Value) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If mrc.EOF Then
        MsgBox "抱歉，没有该时间段内的记录！", 0 + 48, "提示"
        DTPicker1.SetFocus
'        DTPicker1.Value = ""
'        DTPicker2.Value = ""
        Exit Sub
    Else
        With myflexgrid
            .Rows = 1
        Do While Not mrc.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = mrc.Fields(2)
            .TextMatrix(.Rows - 1, 1) = mrc.Fields(3)
            .TextMatrix(.Rows - 1, 2) = mrc.Fields(4)
            .TextMatrix(.Rows - 1, 3) = mrc.Fields(5)
            .TextMatrix(.Rows - 1, 4) = mrc.Fields(6)
            '已解决，无效使用null
            .TextMatrix(.Rows - 1, 5) = Format(mrc.Fields(7))
            mrc.MoveNext
        Loop
        End With
        mrc.Close
    End If
     
    
End Sub

     导出为excel，则是把数据库中相应表的信息导出到excel中。

     如下为参考代码：

     

Private Sub cmdExcel_Click()
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim i As Integer
    Dim x1app1 As Excel.Application '定义一个excel
    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,addmoney,date,time,UserID,status from ReCharge_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
    
    
End Sub

      小结

     我觉得能通过VB实现一些交互是很神奇的事情。 VB就像一个点，向四周发散去产生更多的交际。