⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 b基本信息.frm

📁 人事管理系统:包括员工公资的管理,考勤的管理,还有各种考核等功能
💻 FRM
📖 第 1 页 / 共 2 页
字号:
            Width           =   615
         End
         Begin VB.Label Label7 
            Caption         =   "出生日期:"
            Height          =   375
            Index           =   0
            Left            =   2640
            TabIndex        =   22
            Top             =   960
            Width           =   1335
         End
         Begin VB.Label Label8 
            Caption         =   "(8位)"
            Enabled         =   0   'False
            ForeColor       =   &H000000FF&
            Height          =   255
            Left            =   2280
            TabIndex        =   21
            Top             =   480
            Width           =   615
         End
      End
      Begin VB.Frame FrameStuList 
         Caption         =   "学生列表"
         Height          =   5415
         Left            =   120
         TabIndex        =   18
         Top             =   240
         Width           =   2055
         Begin VB.ListBox ListStu 
            Height          =   4935
            Left            =   120
            TabIndex        =   19
            Top             =   240
            Width           =   1815
         End
      End
   End
End
Attribute VB_Name = "B基本信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Dim strClassNo As String '班号
Dim flag As String '判断是新增加记录还是修改记录
Private Sub FixData() '显示数据
    Dim stuNo As String '学号
    If ListStu.ListCount > 0 Then
        stuNo = Left(Trim(ListStu.Text), 8)
    End If
    FrameStuInfo.Caption = stuNo & "号学生信息"
    '查找数据
    rs.MoveFirst
    rs.Find ("学号='" & stuNo & "'")
    txtItem(0).Text = Trim(rs.Fields("学号"))
    txtItem(1).Text = Trim(rs.Fields("姓名"))
    If IsDate(Trim(rs.Fields("入学日期"))) Then
        DTPicker1(0).Value = Trim(rs.Fields("入学日期")) '时间控件
    End If
    CboSelect(0).Text = Trim(rs.Fields("性别"))
    If IsDate(Trim(rs.Fields("出生日期"))) Then
        DTPicker1(1).Value = Trim(rs.Fields("出生日期")) '时间控件
    End If
    txtItem(2).Text = Trim(rs.Fields("籍贯"))
    CboSelect(1).Text = Trim(rs.Fields("民族"))
    txtItem(3).Text = Trim(rs.Fields("身份证号"))
    CboSelect(2).Text = Trim(rs.Fields("政治面貌"))
    txtItem(4).Text = Trim(rs.Fields("电话"))
    txtItem(5).Text = Trim(rs.Fields("住址"))
    txtItem(6).Text = Trim(rs.Fields("邮箱"))
    txtItem(7).Text = Trim(rs.Fields("教育背景"))
    txtItem(8).Text = Trim(rs.Fields("备注"))
    '控件可用性
    For Index = 1 To 8
        txtItem(Index).Enabled = False
    Next Index
    For Index = 0 To 2
        CboSelect(Index).Enabled = False
    Next Index
    For Index = 0 To 1
        DTPicker1(0).Enabled = False
    Next Index
End Sub
Private Function CheckData() As Boolean
'检查数据的合法性
    Dim rst As ADODB.Recordset
    Dim msgt As String
    msgt = ""
    '检查数据非空性
    If Trim(txtItem(0).Text) = "" Then
        msgt = "学号为空; "
    ElseIf Not Len(Trim(txtItem(0).Text)) = 8 Then
        msgt = "学号不是8位; "
    ElseIf Not Left(Trim(txtItem(0).Text), 6) = strClassNo Then
        msgt = "学号错误; "
    End If
    If Trim(txtItem(1).Text) = "" Then
        msgt = msgt & " 姓名为空; "
    End If
    If Not msgt = "" Then
        MsgBox (msgt)
        CheckData = False
        Exit Function
    End If
    '检查唯一性
    SQL = " select 学号 from 学生基本信息表 where 学号='" & Trim(txtItem(0).Text) & "'"
    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
    '初始化学生ListBox
    SQL = " select * from 学生基本信息表"
    SQL = SQL & " where 班号='" & strClassNo & "'  order by 学号"
    Set rs = Nothing
    Set rs = SelectSQL(SQL, msg)
    ListStu.Clear
    If rs.RecordCount > 0 Then
        Do While (Not rs.EOF) And (Not rs.BOF)
            strItem = rs.Fields(0) & " " & rs.Fields(1)
            ListStu.AddItem (strItem)
            rs.MoveNext
        Loop
        rs.MoveFirst
        ListStu.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 CmdAdd_Click()
    '清空文本框,重新设置下拉框、日期控件
    For Index = 0 To 8
        txtItem(Index).Text = ""
        txtItem(Index).Enabled = True
    Next Index
    For Index = 0 To 2
        CboSelect(Index).ListIndex = 0
        CboSelect(Index).Enabled = True
    Next Index
    For Index = 0 To 1
        DTPicker1(Index).Refresh
        DTPicker1(Index).Enabled = True
    Next Index
    ListStu.Enabled = False
    txtItem(0).Text = strClassNo
    txtItem(0).SetFocus
    '设置标志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
        '文本框可用,学号不可以修改
        For Index = 1 To 8
            txtItem(Index).Enabled = True
        Next Index
        txtItem(0).Enabled = False '学号控件不可用
        ListStu.Enabled = False
        For Index = 0 To 2
            CboSelect(Index).Enabled = True
        Next Index
        For Index = 0 To 1
            DTPicker1(0).Enabled = True
        Next Index
        '设置标志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 txtItem(0).Text = "" Then
        MsgBox ("选择需要删除的学生!")
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
        msg = MsgBox("删除该条记录吗?", vbYesNo)
        If msg = vbYes Then
            rs.Delete
            Call LoadData '重新装载数据
            '清空文本框,重新设置下拉框、日期控件
            For Index = 1 To 8
                txtItem(Index).Text = ""
                txtItem(Index).Enabled = False
            Next Index
            For Index = 0 To 2
                CboSelect(Index).ListIndex = 0
                CboSelect(Index).Enabled = False
            Next Index
            For Index = 0 To 1
                DTPicker1(Index).Refresh
                DTPicker1(Index).Enabled = False
            Next Index
            '按钮可用性处理
            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 '设置数据
    ListStu.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(txtItem(0).Text)
    rs.Fields("姓名") = Trim(txtItem(1).Text)
    rs.Fields("班号") = Trim(strClassNo)
    rs.Fields("入学日期") = Trim(DTPicker1(0).Value) '时间控件
    rs.Fields("性别") = Trim(CboSelect(0).Text)
    rs.Fields("出生日期") = Trim(DTPicker1(1).Value) '时间控件
    rs.Fields("籍贯") = Trim(txtItem(2).Text)
    rs.Fields("民族") = Trim(CboSelect(1).Text)
    rs.Fields("身份证号") = Trim(txtItem(3).Text)
    rs.Fields("政治面貌") = Trim(CboSelect(2).Text)
    rs.Fields("电话") = Trim(txtItem(4).Text)
    rs.Fields("住址") = Trim(txtItem(5).Text)
    rs.Fields("邮箱") = Trim(txtItem(6).Text)
    rs.Fields("教育背景") = Trim(txtItem(7).Text)
    rs.Fields("备注") = Trim(txtItem(8).Text)
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 '重新装载数据
    '控件可用性
    For Index = 0 To 8
        txtItem(Index).Enabled = False
    Next Index
    For Index = 0 To 2
        CboSelect(Index).ListIndex = 0
        CboSelect(Index).Enabled = False
    Next Index
    For Index = 0 To 1
        DTPicker1(Index).Refresh
        DTPicker1(Index).Enabled = False
    Next Index
    ListStu.Enabled = True
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
    If flag = "Add" Then
        '修改注册信息表
        SQL = "update 学生注册信息表 set 学期1='" & Me.DTPicker1(0).Value & "'  where 学号='"
        SQL = SQL & txtItem(0).Text & "'"
        Call ExecuteSQL(SQL, msg)
        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()
'初始化下拉框
    CboSelect(0).AddItem "男"
    CboSelect(0).AddItem "女"
    CboSelect(0).ListIndex = 0
    CboSelect(1).AddItem "汉族"
    CboSelect(1).AddItem "回族"
    CboSelect(1).AddItem "藏族"
    CboSelect(1).AddItem "其他"
    CboSelect(1).ListIndex = 0
    CboSelect(2).AddItem "党员"
    CboSelect(2).AddItem "民主人士"
    CboSelect(2).AddItem "团员"
    CboSelect(2).AddItem "群众"
    CboSelect(2).ListIndex = 0
    '得到班号
    strClassNo = B学生查询.strQuery
    FrameStuInfo.Caption = strClassNo & "班学生列表"
    Call LoadData '装载数据
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
    学生档案管理.Enabled = True
    B学生查询.Enabled = True
    Unload Me
End Sub
Private Sub ListStu_Click()
    Call FixData
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -