b学籍异动.frm

人事管理系统:包括员工公资的管理,考勤的管理,还有各种考核等功能

        DTPicker1.Value = Trim(rs.Fields("异动日期")) '时间控件
    End If
    txtReason.Text = Trim(rs.Fields("异动原因"))
    '控件可用性
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Function CheckData() As Boolean
    '检查数据的合法性
    Dim rst As ADODB.Recordset
    '检查唯一性
    SQL = " select 异动ID from 学籍异动信息表 where " & "学号='"
    SQL = SQL & Left(Trim(CboStu.Text), 8) & "' and 异动日期='" & Trim(DTPicker1.Value) & "'"
    Set rst = SelectSQL(SQL, msg)
    If flag = "Add" And rst.RecordCount > 0 Then
        MsgBox ("同一日期不可能有多次异动，重复添加!")
        rst.Close
        CheckData = False
        Exit Function
    End If
    CheckData = True '合法
End Function
Private Sub LoadData()
    Dim strItem As String
    '得到学生的学籍异动信息
    SQL = " select * from 学籍异动信息表"
    SQL = SQL & " where 学号='" & Left(Trim(CboStu.Text), 8) & "'  order by 异动ID"
    Set rs = Nothing
    Set rs = SelectSQL(SQL, msg)
    ListChange.Clear
    If rs.RecordCount > 0 Then
        Do While (Not rs.EOF) And (Not rs.BOF)
            strItem = Trim(rs.Fields(3)) & ":" & Trim(rs.Fields(2))
            ListChange.AddItem (strItem)
            rs.MoveNext
        Loop
        rs.MoveFirst
        ListChange.ListIndex = 0
    Else
        MsgBox ("目前没有异动信息！")
        '控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = False: CmdSave.Enabled = False
        Exit Sub
    End If
    Call FixData '在文本框中显示详细信息
    '控件可用性
    CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
    CmdCancel.Enabled = False: CmdSave.Enabled = False
End Sub
Private Sub CboStu_Click()
    Call LoadData  '重新装载数据
End Sub
Private Sub CmdAdd_Click()
    '可用性，清空数据
    txtReason.Text = ""
    DTPicker1.Refresh
    CboSelect.ListIndex = 0
    txtReason.Enabled = True
    DTPicker1.Enabled = True
    CboSelect.Enabled = True
    ListChange.Enabled = False
    CboStu.Enabled = False
    '设置标志flag
    flag = "Add"
    '添加、修改、删除按钮不可用，取消、保存按钮可用
    CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    CmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()
    '修改操作
    If rs.RecordCount > 0 Then
        '可用性
        txtReason.Enabled = True
        DTPicker1.Enabled = True
        CboSelect.Enabled = True
        ListChange.Enabled = False
        CboStu.Enabled = False
        '设置标志flag
        flag = "Modify"
        '添加、修改、删除按钮不可用，取消、保存按钮可用
        CmdCancel.Enabled = True: CmdSave.Enabled = True
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    Else
        MsgBox ("没有可以修改的数据!")
    End If
End Sub
Private Sub CmdDelete_Click()
    '删除操作
    On Error GoTo ErrMsg
    If rs.RecordCount > 0 Then
        msg = MsgBox("删除该条记录吗?", vbYesNo)
        If msg = vbYes Then
            rs.Delete
            Call LoadData '重新装载数据
            '清空文本框,重新设置下拉框
            txtReason.Text = ""
            DTPicker1.Refresh
            CboSelect.ListIndex = 0
            txtReason.Enabled = False
            DTPicker1.Enabled = False
            CboSelect.Enabled = False
            ListChange.Enabled = True
            CboStu.Enabled = True
            '按钮可用性处理
            CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = True
            CmdSave.Enabled = False: CmdCancel.Enabled = False
            MsgBox ("成功删除的数据!")
        End If
    Else
        MsgBox ("没有可删除的数据!")
    End If
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub cmdCancel_Click()
'取消操作
    Call FixData '设置数据
    ListChange.Enabled = True
    CboStu.Enabled = True
    '修改、删除、添加按钮可用,保存和取消按钮不可用
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub setData()
    rs.Fields("异动原因") = Trim(txtReason.Text)
    rs.Fields("异动日期") = Trim(DTPicker1.Value)
    rs.Fields("异动类型") = Trim(CboSelect.Text)
    rs.Fields("学号") = Left(Trim(CboStu.Text), 8)
End Sub
Private Sub CmdSave_Click()
    On Error GoTo ErrMsg
    If Not CheckData Then Exit Sub '如果数据不合法退出
    If flag = "Modify" Then '如果是修改数据
        msg = MsgBox("您确实要修改这条数据吗?", vbYesNo)
        If msg = vbYes Then
            Call setData '赋值
        Else
            Exit Sub
        End If
    ElseIf flag = "Add" Then '如果是添加新数据
        rs.AddNew
        Call setData
    End If
    '更新数据处理控件
    rs.Update
    Call LoadData '重新装载数据
    '控件清空和可用性
    txtReason.Text = ""
    DTPicker1.Refresh
    CboSelect.ListIndex = 0
    txtReason.Enabled = False
    DTPicker1.Enabled = False
    CboSelect.Enabled = False
    ListChange.Enabled = True
    CboStu.Enabled = True
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
    If flag = "Add" Then
        MsgBox ("成功添加数据!")
    Else
        MsgBox ("成功更新数据!")
    End If
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbExclamation, "出错"
End Sub

Private Sub CmdExit_Click()
'退出操作
    学生档案管理.Enabled = True
    rs.Close
    B学生查询.Enabled = True
    Unload Me
End Sub
Private Sub Form_Load()
    Dim strItem As String
    '得到班号
    strClassNo = B学生查询.strQuery
    '初始化下拉框
    CboSelect.AddItem "复读"
    CboSelect.AddItem "停学"
    CboSelect.AddItem "转系"
    CboSelect.AddItem "退学"
    CboSelect.AddItem "其他"
    CboSelect.ListIndex = 0
    '初始化学生下拉框
    SQL = " select 学号,姓名 from 学生基本信息表"
    SQL = SQL & " where 班号='" & strClassNo & "'  order by 学号"
    Set rs = Nothing
    Set rs = SelectSQL(SQL, msg)
    CboStu.Clear
    If rs.RecordCount > 0 Then
        Do While (Not rs.EOF) And (Not rs.BOF)
            strItem = rs.Fields(0) & " " & rs.Fields(1)
            CboStu.AddItem (strItem)
            rs.MoveNext
        Loop
        rs.MoveFirst
        CboStu.ListIndex = 0
    Else
        MsgBox ("目前没有学生信息！")
        '控件可用性
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = False: CmdSave.Enabled = False
        Exit Sub
    End If
    Call LoadData '装载学生异动数据
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
    学生档案管理.Enabled = True
    B学生查询.Enabled = True
    Unload Me
End Sub
Private Sub ListChange_Click()
    Call FixData
End Sub