第一次机房收费系统之学生查看上机记录

流程图

代码部分

Private Sub Command1_Click()
        Dim txtSQL As String       '用于存放SQL语句
        Dim MsgText As String      '用于存放返回信息
        Dim mrc As ADODB.Recordset '用于存放student记录集
        Dim mrc1 As ADODB.Recordset 'Line
        MSHFlexGrid1.Clear
   	 	With MSHFlexGrid1
	        .Rows = 1
	        .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) = "备注"
   	 	End With
        If Not IsNumeric(Trim(Text1.Text)) Then
            MsgBox "请输入数字"
            Text1.Text = ""
            Text1.SetFocus
        	Else
            txtSQL = "select * from Student_Info where cardno='" & Trim(Text1.Text) & "' "
            Set mrc = ExecuteSQL(txtSQL, MsgText)
      
        	If mrc.EOF Then
                MsgBox "此卡未被注册，请重新输入！", vbOKCancel + vbQuestion, "提示"
                Text1.SetFocus
                Exit Sub
        	End If
            	txtSQL = "select * from Line_Info where cardno='" & Trim(Text1.Text) & "'"
            	Set mrc1 = ExecuteSQL(txtSQL, MsgText)
        		If mrc.EOF Then
            		MsgBox "没有上机记录"
            		Text1.SetFocus
            		Text1.Text = ""
        		Else
            	'对MSHFlexGrid控件进行操作
            	With MSHFlexGrid1
            	'判断是否移动到数据集对象的最后一条记录
                Do While mrc1.EOF = False
                    .Rows = .Rows + 1
                    .CellAlignment = 4
                    .TextMatrix(.Rows - 1, 0) = Trim(mrc1.Fields(1))
                    .TextMatrix(.Rows - 1, 1) = Trim(mrc1.Fields(3))
                    .TextMatrix(.Rows - 1, 2) = Trim(mrc1.Fields(6))
                    .TextMatrix(.Rows - 1, 3) = Trim(mrc1.Fields(7))
                    .TextMatrix(.Rows - 1, 4) = Trim(mrc1.Fields(8))
                    .TextMatrix(.Rows - 1, 5) = Trim(mrc1.Fields(9))
                    .TextMatrix(.Rows - 1, 6) = Trim(mrc1.Fields(11))
                    .TextMatrix(.Rows - 1, 7) = Trim(mrc1.Fields(12))
                    .TextMatrix(.Rows - 1, 8) = Trim(mrc1.Fields(13))
                    '移动到下一条记录
                    mrc1.MoveNext
                Loop
            End With
            mrc.Close
        End If
    End If
End Sub
Private Sub Command2_Click()
       Dim Excelapp As Excel.Application  '定义Excel表格应用程序
       Dim Excebook 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 "没有可以导出的数据"
       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