【前言】
開始做機房時間也不短了，也看了不少大佬的部落格，但是真的是每個人有每個人的思路，所以我也有了自己的思路。剛開始的時候沒有什麼思路，不知道如何下手，只有靜下心來，一點點往下走，才能理清自己的思路。有些地方可能還存在不足，望指點。
【內容】
上機和下機導圖


上機程式碼

Private Sub cmdOnLine_Click()

Dim MsgText As String
Dim Stusql As String
Dim OnLinesql As String
Dim Linesql As String
Dim BasicDatasql As String
Dim mrcStu As ADODB.Recordset
Dim mrcOnLine As ADODB.Recordset
Dim mrcLine As ADODB.Recordset
Dim mrcBasicData As ADODB.Recordset
   
    '判斷卡號是否為空
    If txtCardNo.Text = "" Then
        MsgBox "卡號不能為空，請輸入卡號！", 48, "警告"
        txtCardNo.SetFocus
        Exit Sub
    End If
     
    '判斷卡號是否為數字
    If Not IsNumeric(Trim(txtCardNo.Text)) Then
        MsgBox "請輸入數字！", vbOKOnly + vbExclamation, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
    
    '判斷該卡號是否已註冊
    Stusql = "select * from student_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
    Set mrcStu = ExecuteSQL(Stusql, MsgText)
    If mrcStu.EOF = True Then
        MsgBox "該卡號不存在，請註冊！", 48, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    Else
        '判斷卡號是否退卡
        If mrcStu.EOF Then
            MsgBox "此卡已經退卡", vbOKOnly + vbExclamation, "提示"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        End If
    End If
        
    '判斷餘額是否充足
    BasicDatasql = "select * from BasicData_Info"
    Set mrcBasicData = ExecuteSQL(BasicDatasql, MsgText)
    If mrcStu.Fields(7) < mrcBasicData.Fields(5) Then
        MsgBox "餘額不足，請先充值再上機！", 48, "提示"
        Exit Sub
    End If
    
    '判斷該卡號是否正在上機
    OnLinesql = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
    If mrcOnLine.EOF = False Then
        MsgBox "該卡正在上機，不能重複上機！", 64, "提示"
        Exit Sub
    End If
    
    '呼叫學生資訊到輸入框
    txtCardNo.Text = mrcStu.Fields(0)
    txtType.Text = mrcStu.Fields(14)
    txtSID.Text = mrcStu.Fields(1)
    txtName.Text = mrcStu.Fields(2)
    txtDept.Text = mrcStu.Fields(4)
    comboSex.Text = mrcStu.Fields(3)
    txtCash.Text = mrcStu.Fields(7)
    txtOnDate.Text = Date
    txtOnTime.Text = Time
    txtOffDate.Text = ""
    txtOffTime.Text = ""
    txtCMoney.Text = ""
    txtCTime = ""
      
    '上機時將上機卡的資料同步至online_info表中
    Set mrcOnLine = New ADODB.Recordset
    OnLinesql = "select * from OnLine_info"
    Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
    mrcOnLine.AddNew
    mrcOnLine.Fields(0) = Trim(txtCardNo.Text)
    mrcOnLine.Fields(1) = Trim(txtType.Text)
    mrcOnLine.Fields(2) = Trim(txtSID.Text)
    mrcOnLine.Fields(3) = Trim(txtName.Text)
    mrcOnLine.Fields(4) = Trim(txtDept.Text)
    mrcOnLine.Fields(5) = Trim(comboSex.Text)
    mrcOnLine.Fields(6) = Trim(txtOnDate.Text)
    mrcOnLine.Fields(7) = Trim(txtOnTime.Text)
    mrcOnLine.Fields(8) = Trim(VBA.Environ("computername"))    '將計算機名同步到資料庫的相應表格中
    lblAmount.Caption = mrcOnLine.RecordCount + 1  '顯示上機人數
    mrcOnLine.Update
    mrcOnLine.Close
    
    '上機時將上機卡的資料同步到line_info表中
    Set mrcLine = New ADODB.Recordset
    Linesql = "select * from line_info"
    Set mrcLine = ExecuteSQL(Linesql, MsgText)
    mrcLine.AddNew
    mrcLine.Fields(1) = Trim(txtCardNo.Text)
    mrcLine.Fields(2) = Trim(txtSID.Text)
    mrcLine.Fields(3) = Trim(txtName.Text)
    mrcLine.Fields(4) = Trim(txtDept.Text)
    mrcLine.Fields(5) = Trim(comboSex.Text)
    mrcLine.Fields(6) = Trim(txtOnDate.Text)
    mrcLine.Fields(7) = Trim(txtOnTime.Text)
    mrcLine.Fields(13) = "正常上機"
    mrcLine.Fields(14) = Trim(VBA.Environ("computername"))
    mrcLine.Update
    mrcLine.Close
    MsgBox "上機成功！", 64, "提示"
        
    '顯示正在上機的人數
    OnLinesql = "select * from OnLine_Info"
    Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
    If mrcOnLine.EOF = True Then
        lblAmount.Caption = 0
    Else
        lblAmount.Caption = mrcOnLine.RecordCount
    End If
End Sub
 

下機程式碼

Private Sub cmdOffLine_Click()
 
Dim MsgText As String
Dim StuSQL As String
Dim OnLineSQL As String
Dim BasicDataSQL As String
Dim LineSQL As String
Dim mrcStu As ADODB.Recordset
Dim mrcOnLine As ADODB.Recordset
Dim mrcBasicData As ADODB.Recordset
Dim mrcLine As ADODB.Recordset
   
    '判斷卡號是否為空
    If Trim(txtCardNo.Text = "") Then
        MsgBox "請輸入卡號！", vbOKOnly + vbInformation, "溫馨提示"
        txtCardNo.SetFocus
        Exit Sub
    End If
   
    '判斷卡號是否為數字
    If Not IsNumeric(txtCardNo.Text) Then
        MsgBox "請輸入數字！", vbOKOnly + vbInformation, "溫馨提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
   
    '判斷卡號是否存在
    StuSQL = "select * from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrcStu = ExecuteSQL(StuSQL, MsgText)
    If mrcStu.EOF = True Then
        MsgBox "您輸入的卡號還未註冊，請先註冊！", 48, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
   
    '判斷該卡是否正在上機
    OnLineSQL = "select * from OnLine_info where cardno='" & txtCardNo.Text & "'"
    Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
    If mrcOnLine.EOF = True Then
        MsgBox "該卡未上機，請先上機再下機！", 48, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    Else
        txtCardNo.Text = mrcOnLine.Fields(0)
        txtType.Text = mrcOnLine.Fields(1)
        txtSID.Text = mrcOnLine.Fields(2)
        txtName.Text = mrcOnLine.Fields(3)
        txtDept.Text = mrcOnLine.Fields(4)
        comboSex.Text = mrcOnLine.Fields(5)
        txtOnDate.Text = mrcOnLine.Fields(6)
        txtOnTime.Text = mrcOnLine.Fields(7)
        txtOffTime.Text = Time
        txtOffDate.Text = Format(Date, "yyyy-mm-dd")
        
        '線上時長計算
        linetime = (Date - DateValue(mrcOnLine!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrcOnLine!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrcOnLine!OnTime))) '時間單位為分鐘
                         
        '計算消費金額;消費時間小於準備時間，則消費金額為0
        BasicDataSQL = "select * from basicdata_info "
        Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText)
    
        If Trim(linetime) <= Val(mrcBasicData.Fields(4)) Then
           txtCMoney.Text = 0
           txtCTime.Text = 0
        Else
           consumetime = Val(linetime) - Val(mrcBasicData.Fields(4))
           txtCTime.Text = linetime
           If Trim(txtType.Text) = "固定使用者" Then
                txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(0), "0.00")
           Else
                txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(1), "0.00")
           End If
        End If
   
        '計算餘額
        txtCash.Text = Val(mrcStu.Fields(7)) - Val(Trim(txtCMoney.Text))
        
        '將餘額更新到student表中
        mrcStu.Fields(7) = Val(Trim(txtCash.Text))
        mrcStu.Update
        mrcStu.Close
    End If
       
    '刪除line表中上機的資訊
    LineSQL = "select * from line_info where cardno='" & txtCardNo.Text & "'"
    Set mrcLine = ExecuteSQL(LineSQL, MsgText)
    mrcLine.Delete
    mrcLine.Update
    mrcLine.Close
    
    '更新Line表
    LineSQL = "select * from line_info where cardno='" & txtCardNo.Text & "'"
    Set mrcLine = ExecuteSQL(LineSQL, MsgText)
    With mrcLine
        .AddNew
        .Fields(1) = Trim(txtCardNo.Text)
        .Fields(2) = Trim(txtSID.Text)
        .Fields(3) = Trim(txtName.Text)
        .Fields(4) = Trim(txtDept.Text)
        .Fields(5) = Trim(comboSex.Text)
        .Fields(6) = mrcOnLine!ondate
        .Fields(7) = mrcOnLine!OnTime
        !COMPUTER = VBA.Environ("computername")
        !offdate = Trim(txtOffDate.Text)
        !offtime = Trim(txtOffTime.Text)
        !consumetime = Trim(txtCTime.Text)
        !consume = Trim(txtCMoney.Text)
        !cash = Trim(txtCash.Text) & ""
        !Status = "正常下機"
        .Update
        .Close
    End With
    
      '更新online表
    mrcOnLine.Delete
    mrcOnLine.Update
    mrcOnLine.Close

    '顯示正在上機的人數
    OnLineSQL = "select * from OnLine_Info"
    Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
    If mrcOnLine.EOF = True Then
        lblAmount.Caption = 0
    Else
        lblAmount.Caption = mrcOnLine.RecordCount
    End If
End Sub