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

一、思维导图

三、[VB MSHFlexGrid控件:CellAlignment 属性]

二、代码

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