【第一次機房收費系統】—學生檢視上機記錄
阿新 • • 發佈:2018-12-19
一、思維導圖
二、程式碼
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