【机房收费系统】——充值记录查询

查询的流程代码什么的都差不多，只是改几个值。

Private Sub cmdOk_Click()
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    Dim txtSQL As String
    
    
    txtSQL = "select * from Line_Info where cardno ='" & txtCardNumber.Text & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)

    If Trim(txtCardNumber.Text = "") Then
        MsgBox "卡号为空，请输入卡号！", vbOKOnly + vbExclamation, "警告"
        txtCardNumber.SetFocus
    End If
    
    MSshow.Clear
    With MSshow
        .Rows = 1
        .TextMatrix(0, 0) = "卡号"
        .TextMatrix(0, 1) = "充值金额"
        .TextMatrix(0, 2) = "充值日期"
        .TextMatrix(0, 3) = "充值时间"
        .TextMatrix(0, 4) = "充值老师"

    End With
        
        '判断是否存在收取金额记录
        If mrc.EOF = True Then
            MsgBox "没有上机记录！", vbOKOnly + vbInformation, "提示"
            Exit Sub
        Else
            With MSshow
                '判断是否移动到数据集对象的最后一条记录
                Do While mrc.EOF = False
                    .Rows = .Rows + 1
                    .CellAlignment = 4
                    .TextMatrix(.Rows - 1, 0) = Trim(mrc.Fields(2))
                    .TextMatrix(.Rows - 1, 1) = Trim(mrc.Fields(3))
                    .TextMatrix(.Rows - 1, 2) = Trim(mrc.Fields(4))
                    .TextMatrix(.Rows - 1, 3) = Trim(mrc.Fields(5))
                    .TextMatrix(.Rows - 1, 4) = Trim(mrc.Fields(6))
                    
                    '移动到下一条记录
                    mrc.MoveNext
                Loop
            mrc.Close
            End With
       
         End If
End Sub

'限制特殊字符和字母
Private Sub txtCardNumber_KeyPress(KeyAscii As Integer)
    Dim cTemp As String
    cTemp = "`~!@#$%^&*()-=_+[]{};:'\|<>/?.‘“”’、，。——+（）《》？,~·……￥！：；【】" & """ '禁止输入特殊的字符"
    If InStr(1, cTemp, Chr(KeyAscii)) <> 0 Then
        KeyAscii = 0
    End If
    
    If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then
     Else
       KeyAscii = 0
                MsgBox "只能输入数字", vbOKCancel + vbExclamation, "提示"
       txtCardNumber.Text = ""
    End If
End Sub

Private Sub cmdExport_Click()
    '新建一个Excel文件
    Dim xlAPP As Object
    Dim xlBook As Object
    Dim xSheet As Object
    '导出Excel文件
    Dim i As Long
    Dim j As Integer
    
    On Error GoTo err_proc
    '创建一个电子表格
    Set xlAPP = CreateObject("Excel.application")
    '创建一个工作簿文件
    Set xlBook = xlAPP.workbooks.Add
    '创建一个Sheet表
    Set xSheet = xlBook.worksheets(1)
    With MSshow
        '读取所有行
        For i = 0 To .Rows - 1
        '读取所有列
        For j = 0 To .Cols - 1
        xSheet.cells(i + 1, j + 1).Value = .TextMatrix(i, j)
        Next j
        Next i
    End With
    '使Excel表可见
    xlAPP.Visible = True
    Exit Sub
err_proc:
    Screen.MousePointer = vbDefault
    MsgBox "请确认您的电脑安装了Excel！", vbOKCancel + vbQuestion, "提示"

End Sub