1. 程式人生 > >【第一次機房收費系統】—學生檢視上機記錄

【第一次機房收費系統】—學生檢視上機記錄

一、思維導圖 在這裡插入圖片描述

二、程式碼

Private Sub cmdInquiry_Click()
    Dim txtSQL As String
    Dim msgtext As String
    Dim mrc As ADODB.Recordset
    
    txtSQL = "select * from student_Info where"
    If Trim(txtcard.Text) = "" Then
        MsgBox "卡號不能為空", vbOKOnly + vbExclamation, "警告"
        txtcard.SetFocus
        Exit Sub
    
    Else
        If Not IsNumeric(Trim(txtcard.Text)) Then
            MsgBox "請輸入數字!", vbOKOnly + vbExclamation, "警告"
            Exit Sub
            txtcard.SetFocus
            Exit Sub
            
    Else
        txtSQL = "select * from student_Info where cardno='" & txtcard.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, msgtext)
        If mrc.EOF = True Then
        MsgBox "無資料", 48, "警告"
        txtcard.Text = ""
        txtcard.SetFocus
    Else
        txtSQL = "select * from Line_Info where cardno ='" & Trim(txtcard.Text) & "'"
        Set mrc = ExecuteSQL(txtSQL, msgtext)
        
        If mrc.EOF = False Then
         With MSHFlexGrid1
        Do While mrc.EOF = False
            .TextMatrix(0, 0) = "卡號"
            .TextMatrix(0, 1) = "姓名"
            .TextMatrix(0, 2) = "上機日期"
            .TextMatrix(0, 3) = "上機時間"
            .TextMatrix(0, 4) = "下機日期"
            .TextMatrix(0, 5) = "下機時間"
            .TextMatrix(0, 6) = "消費金額"
            .TextMatrix(0, 7) = "餘額"
            .TextMatrix(0, 8) = "備註"
            .CellAlignment = 4
            .TextMatrix(.Rows - 1, 0) = mrc.Fields(1)
            .TextMatrix(.Rows - 1, 1) = mrc.Fields(3)
            .TextMatrix(.Rows - 1, 2) = mrc.Fields(6)
            .TextMatrix(.Rows - 1, 3) = mrc.Fields(7)
            .TextMatrix(.Rows - 1, 4) = mrc.Fields(8)
            .TextMatrix(.Rows - 1, 5) = mrc.Fields(9)
            .TextMatrix(.Rows - 1, 6) = mrc.Fields(11)
            .TextMatrix(.Rows - 1, 7) = mrc.Fields(12)
            .TextMatrix(.Rows - 1, 8) = mrc.Fields(13)
                mrc.MoveNext
            
            Loop
            
        End With
        
        mrc.Close
        End If
    End If
    End If
    End If

End Sub

------------------------------------------------------------------------------------------
匯出為EXCEL

Private Sub cmdExportExcel_Click()
    Dim Excelapp As Excel.Application '定義Excel表格應用程式
    Dim Excelbook As Excel.Workbook '定義Excel表格工作簿
    Dim excelSheet As Excel.Worksheet '定義Excel表格工作表
    Dim ExcelRange As Excel.Range
    
    Dim i As Integer '定義Excel表中橫座標
    Dim j As Integer '定義Excel表中列變數
    
    Set Excelapp = CreateObject("Excel.application") '建立一個excel應用程式物件
    Set Excelbook = Excelapp.Workbooks.Add '建立一個工作簿
    Set excelSheet = Excelbook.Worksheets(1) '建立一個工作簿
    
    DoEvents
    '因以下程式碼執行時間較長,所以轉讓控制權,讓作業系統處理其他事件,避免操作不響應誤認為宕機
    
    If MSHFlexGrid1.Rows <= 1 Then
        MsgBox "沒有可匯出資料!", vbOKOnly, "溫馨提示:"
    End If
    
    With MSHFlexGrid1
        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 '顯示Excel表格
    
    Set Excelapp = Nothing '釋放ExcelApp物件
    Set Excelbook = Nothing
    Set excelSheet = Nothing
    
End Sub