📄 f用户管理.frm
字号:
Left = 240
TabIndex = 30
Top = 480
Width = 855
End
Begin VB.Label Label5
Caption = "用户类别："
Height = 255
Index = 1
Left = 120
TabIndex = 29
Top = 960
Width = 975
End
Begin VB.Label Label2
Caption = "(4位)"
ForeColor = &H000000FF&
Height = 375
Index = 0
Left = 3000
TabIndex = 28
Top = 480
Width = 495
End
Begin VB.Label Label3
Caption = "用户名称："
Height = 375
Left = 3480
TabIndex = 27
Top = 480
Width = 975
End
Begin VB.Label Label4
Caption = "电话："
Height = 375
Left = 240
TabIndex = 26
Top = 1440
Width = 615
End
Begin VB.Label Label7
Caption = "邮箱："
Height = 375
Left = 3600
TabIndex = 25
Top = 1320
Width = 855
End
Begin VB.Label Label2
Caption = "(小于10位)"
ForeColor = &H000000FF&
Height = 375
Index = 1
Left = 6240
TabIndex = 24
Top = 840
Width = 855
End
End
End
End
Attribute VB_Name = "F用户管理"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Dim flag As String '判断是新增加的记录还是修改记录
Private Sub Form_Load()
'初始化用户类型下拉框
cbokind.AddItem "员工"
cbokind.AddItem "管理人员"
cbokind.ListIndex = 0 '默认为员工
'初始化用户类别下拉框
CboSelect.AddItem "员工"
CboSelect.AddItem "管理人员"
CboSelect.ListIndex = 0 '默认为员工
Call LoadData '装载用户数据
End Sub
Private Sub LoadData()
Dim strItem As String
Dim strWhere As String
'得到用户信息
strWhere = " where 用户类别='" & Trim(cbokind.Text)
strWhere = strWhere & "' and 用户ID like '" & txtUserIdQuery.Text & "%'"
SQL = " select * from 用户信息表 " & strWhere & " order by 用户ID"
Set rs = Nothing
Set rs = SelectSQL(SQL, msg)
ListUser.Clear '清空用户列表
If rs.RecordCount > 0 Then '如果存在记录
'添加到用户列表
Do While (Not rs.EOF) And (Not rs.BOF)
strItem = Trim(rs.Fields(0)) & ":" & Trim(rs.Fields(1))
ListUser.AddItem (strItem)
rs.MoveNext '指向下一条记录
Loop
rs.MoveFirst '指向记录集的第一条
ListUser.ListIndex = 0 '默ListBox
Else
'控件可用性
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 FixData()
'显示数据
Dim UserID As String
Dim rights As String
'显示具体信息
If ListUser.ListCount > 0 Then
UserID = Left(Trim(ListUser.Text), 4)
Else
Exit Sub
End If
'查找数据
rs.MoveFirst
rs.Find ("用户ID='" & UserID & "'")
'显示数据
txtUserId.Text = Trim(rs.Fields("用户ID"))
txtName.Text = Trim(rs.Fields("用户名称"))
txtPassword.Text = Trim(rs.Fields("密码"))
CboSelect.Text = Trim(rs.Fields("用户类别"))
txtPhone.Text = Trim(rs.Fields("电话"))
txtEmail.Text = Trim(rs.Fields("邮箱"))
txtAddress.Text = Trim(rs.Fields("住址"))
txtCardId.Text = Trim(rs.Fields("身份证"))
rights = Trim(rs.Fields("权限"))
'设置权限的CheckBox
For Index = 0 To 5
ChkRights(Index).Value = 0 '所有的权限CheckBox为“未选中”状态
Next Index
If InStr(rights, "资料管理") Then ChkRights(0).Value = 1
If InStr(rights, "采购管理") Then ChkRights(1).Value = 1
If InStr(rights, "销售管理") Then ChkRights(2).Value = 1
If InStr(rights, "库存管理") Then ChkRights(3).Value = 1
If InStr(rights, "统计分析") Then ChkRights(4).Value = 1
If InStr(rights, "用户管理") Then ChkRights(5).Value = 1
'编辑控件可用性
CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub ControlActiveX(kind As String, flag As Boolean)
'控制控件
'如果进行添加，删除或者保存操作
If kind = "Add" Or kind = "Delete" Or kind = "Save" Then
'所有控件清空或未选择
txtUserId.Text = ""
txtName.Text = ""
txtPassword.Text = ""
CboSelect.ListIndex = 0
txtPhone.Text = ""
txtEmail.Text = ""
txtCardId.Text = ""
txtAddress.Text = ""
For Index = 0 To 5
ChkRights(Index).Value = 0
Next Index
End If
'如果进行修改操作
If kind = "Modify" Then
txtUserId.Enabled = False
Else
txtUserId.Enabled = flag
End If
'设置控件的可用性
txtName.Enabled = flag
txtPassword.Enabled = flag
CboSelect.Enabled = flag
txtPhone.Enabled = flag
txtEmail.Enabled = flag
ListUser.Enabled = Not flag
txtCardId.Enabled = flag
txtAddress.Enabled = flag
For Index = 0 To 5
ChkRights(Index).Enabled = flag
Next Index
End Sub
Private Sub CmdAdd_Click()
'添加操作
'清空数据
Call ControlActiveX("Add", True)
'设置标志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
'可用性
Call ControlActiveX("Modify", True)
'设置标志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 txtUserId.Text = "" Then
MsgBox ("选择需要删除的用户信息！")
Exit Sub
End If
If rs.RecordCount > 0 Then
msg = MsgBox("删除该条记录吗?", vbYesNo)
If msg = vbYes Then
rs.Delete
Call LoadData '重新装载数据
'清空文本框,重新设置下拉框
Call ControlActiveX("Delete", False)
'按钮可用性处理
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 '设置数据
ListUser.Enabled = True
'修改、删除、添加按钮可用,保存和取消按钮不可用
CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
CmdSave.Enabled = False: CmdCancel.Enabled = False
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 ControlActiveX("Save", False)
CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
CmdSave.Enabled = False: CmdCancel.Enabled = False
Call LoadData '重新装载数据
If flag = "Add" Then
MsgBox ("成功添加数据!")
Else
MsgBox ("成功更新数据!")
End If
Exit Sub
ErrMsg:
MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Function CheckData() As Boolean
'检查数据的合法性
Dim rst As ADODB.Recordset
'检查非空性
If (Trim(txtUserId.Text) = "") Then '检查用户ID是否为空
MsgBox ("用户ID不能为空！")
CheckData = False
Exit Function
ElseIf Len(Trim(txtUserId.Text)) <> 4 Then '检查用户ID是否为4位
MsgBox ("用户ID不是4位！")
CheckData = False
Exit Function
ElseIf (Trim(txtName.Text) = "") Then '检查用户名称是否为空
MsgBox ("用户名称不能为空！")
CheckData = False
Exit Function
ElseIf (Trim(CboSelect.Text) = "") Then '检查用户类别是否为空
MsgBox ("用户类别不能为空！")
CheckData = False
Exit Function
End If
'检查记录的唯一性
SQL = " select 用户ID from 用户信息表 where 用户ID='" & Trim(txtUserId.Text) & "'"
Set rst = SelectSQL(SQL, msg)
'如果存在记录且编辑标志为添加，提示重复添加
If flag = "Add" And rst.RecordCount > 0 Then
MsgBox ("用户ID，重复添加!")
rst.Close
CheckData = False
Exit Function
End If
CheckData = True '合法
End Function
Private Sub setData()
'为记录的字段赋值
Dim rights As String
rights = ""
rs.Fields("用户ID") = txtUserId.Text
rs.Fields("用户名称") = txtName.Text
rs.Fields("密码") = txtPassword.Text
rs.Fields("用户类别") = Trim(CboSelect.Text)
rs.Fields("电话") = txtPhone.Text
rs.Fields("邮箱") = txtEmail.Text
rs.Fields("住址") = txtAddress.Text
rs.Fields("身份证") = txtCardId.Text
For Index = 0 To 5
If ChkRights(Index).Value = 1 Then
rights = rights & Trim(ChkRights(Index).Caption) & " : "
End If
Next Index
rs.Fields("权限") = Trim(rights)
End Sub
Private Sub ListUser_Click()
Call FixData '重新显示数据
End Sub
Private Sub CmdQuery_Click()
Call LoadData '重新装载数据
End Sub
Private Sub CmdExit_Click()
'退出操作
进销存管理系统.Enabled = True
rs.Close
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
进销存管理系统.Enabled = True
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -