前言

上機在機房系統是至關重要的，只要捋清思路，把大問題分解成一個個的小問題再去解決，困惑就自然迎刃而解了。來看看我的思路吧！

程式碼片段

Private Sub cmdOnline_Click()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrc3 As ADODB.Recordset
    Dim mrc4 As ADODB.Recordset
    
        'mrc連線學生表
        txtSQL = "select * from student_info where cardno='" & Trim(txtCardNo.Text) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
    
        'mrc1連線online表
        txtSQL = "select * from online_info where cardno='" & Trim(txtCardNo.Text) & "'"
        Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
        'mrc2連線line表
        txtSQL = "select * from line_info where cardno='" & Trim(txtCardNo.Text) & "'"
        Set mrc2 = ExecuteSQL(txtSQL, MsgText)
        
        'mrc3連線basicdata表
        txtSQL = "select * from basicdata_info"
        Set mrc3 = ExecuteSQL(txtSQL, MsgText)
        
        txtSQL = "select * from online_info"
        Set mrc4 = ExecuteSQL(txtSQL, MsgText)
        
        If Trim(txtCardNo.Text) = "" Then
            MsgBox "卡號不能為空！", 48, "警告"
            txtCardNo.SetFocus
            Exit Sub
        End If
        
        If Not IsNumeric(Trim(txtCardNo.Text)) Then
            MsgBox "請輸入數字！", 48, "警告"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        End If
        
        If mrc.EOF = True Then
           MsgBox "此卡未註冊", 0 + 48, "系統提示"
           txtCardNo.SetFocus
           txtCardNo.Text = ""
            Exit Sub
        End If
        
        If Val(mrc.Fields(7)) < Val(mrc3.Fields(5)) Then
            MsgBox "餘額不足，請先充值!", 48, "警告"
            txtCardNo.SetFocus
            Exit Sub
        End If
        
        If mrc1.EOF = True Then
            labSID.Caption = mrc.Fields(1)
            labName.Caption = mrc.Fields(2)
            labSex.Caption = mrc.Fields(3)
            labDept.Caption = mrc.Fields(4)
            labType.Caption = mrc.Fields(14)
            labOnDate.Caption = Date
            labOnTime.Caption = Time
        End If
                
         If mrc1.EOF = False Then
            MsgBox "此卡正在上機，不能重複登入！", 48, "警告"
            txtCardNo.Text = mrc.Fields(0)
            labSID.Caption = mrc.Fields(1)
            labName.Caption = mrc.Fields(2)
            labSex.Caption = mrc.Fields(3)
            labDept.Caption = mrc.Fields(4)
            labType.Caption = mrc.Fields(14)
            labOnDate.Caption = mrc1.Fields(6)
            labOnTime.Caption = mrc1.Fields(7)
        Else
            '更新Online_info表
            With mrc1
                .AddNew
                .Fields(0) = Trim(txtCardNo.Text)
                .Fields(1) = Trim(labType.Caption)
                .Fields(2) = Trim(labSID.Caption)
                .Fields(3) = Trim(labName.Caption)
                .Fields(4) = Trim(labDept.Caption)
                .Fields(5) = Trim(labSex.Caption)
                .Fields(6) = Trim(labOnDate.Caption)
                .Fields(7) = Trim(labOnTime.Caption)
                .Fields(8) = VBA.Environ("computername")
                .Fields(9) = Now
                .Update
            End With
            
            '更新line_info表
            With mrc2
               .AddNew
               .Fields(1) = txtCardNo.Text
               .Fields(2) = labSID.Caption
               .Fields(3) = labName.Caption
               .Fields(4) = labDept.Caption
               .Fields(5) = Trim(labSex.Caption)
               .Fields(6) = labOnDate.Caption
               .Fields(7) = labOnTime.Caption
               .Fields(8) = Null
               .Fields(9) = Null
               .Fields(10) = Null
               .Fields(11) = "0.0"
               .Fields(12) = mrc.Fields(7)
               .Fields(13) = "正常上機"
               .Fields(14) = VBA.Environ("computername")
               .Update
            End With
        End If
        
            Label16.Caption = "當前上機人數:" & mrc4.RecordCount
    
            labOffDate.Caption = ""
            labOffTime.Caption = ""
            labCTime.Caption = ""
            labBalance.Caption = ""
            labCMoney.Caption = ""
        
End Sub
 

顯示當前時間程式碼

Private Sub Timer1_Timer()
    labTimenow.Caption = "當前時間:" & Now
End Sub

結語

在學習的計算機專案中，實踐類的比較有意思，要好好抓住機會多動腦多思考，加油！