Private Sub Command查询_Click()
If Text(0).Text <> "" Then
Adodc1.RecordSource = "Select * From 常见任务表 where 任务名称 like '%" & Text(0).Text & "%'"
Else
Adodc1.RecordSource = "Select * From 常见任务表"
End If
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
Adodc1.RecordSource = "Select * From 常见任务表"
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command选择_Click()
On Error Resume Next
Dim i
For i = 0 To Forms.Count - 1
If Forms(i).Name = rw_formname Then
Forms(i).Text(0) = DataGrid1.Columns(0).Text
End If
Next i
Unload Me
End Sub
Private Sub Form_Load()
Adodc1.CommandType = adCmdUnknown
End Sub
负责人
Public frm_title As String '存储窗体标题
Public frm_datatype As Integer '存储当前管理状态（添加，修改，查询）
Public key_data As String '存储修改主键
Dim search_filter As String '存储筛选条件
Dim search_order As String '存储排序条件
Private Sub Command保存_Click()
On Error GoTo 保存失败错误
'==为添加状态时
If frm_datatype = 1 Then
'判断数据不能为空
If Text1(0).Text <> "" Then
'满足条件添加记录
'----------------------------------
Dim add_conn As New ADODB.Connection '连接数据
Dim add_rs As New ADODB.Recordset
With add_conn
.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
.Open
End With
add_rs.Open "负责人表", add_conn, adOpenKeyset, adLockOptimistic '连接表生成记录集
add_rs.AddNew '添加记录
On Error Resume Next
add_rs!负责人 = Text1(0).Text '新记录赋值
add_rs.Update '更新
add_rs.Close '关闭清空记录集和连接
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox "添加完成"
Text1(0).Text = ""
Adodc1.Refresh '刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus '第一个录入数据控件获得焦点继续录入
'----------------------------------
Else
MsgBox "负责人不能为空"
Exit Sub
End If
End If
'========================================================================为修改状态时
If frm_datatype = 2 Then
'判断数据不能为空
If Text1(0).Text <> "" Then
'判断主键不能重复
If key_data <> Text1(0).Text Then '主键修改，判断主键是否重复
If dcountlink("负责人", "负责人表", "负责人='" & Text1(0) & "'", 0) > 0 Then
MsgBox "该负责人已存在，请修改后重试"
Exit Sub
End If
End If
'满足条件添加记录
'----------------------------------
'连接数据库并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
.Open
End With
Dim update_sql As String
update_sql = "Select * From 负责人表 Where 负责人='" & key_data & "'"
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
'--字段更新
On Error Resume Next
With update_rs
!负责人 = Text1(0).Text '新记录赋值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) '主键赋值
MsgBox "更新完成！"
Adodc1.Refresh '刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus '第一个录入数据控件获得焦点
'----------------------------------
Else
MsgBox "负责人不能为空"
Exit Sub
End If
End If
Exit Sub
保存失败错误:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i '清空控件中的数据
For i = 1 To Text1.Count
Text1(i - 1).Text = ""
Next i
'点击取消时显示全部记录，清空条件
search_filter = ""
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command删除_Click()
On Error GoTo 删除失败错误
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox("是否删除负责人为【" & del_data & "】 的记录？", vbYesNo, "提示") <> vbYes Then '删除前提醒
Exit Sub
End If
'执行删除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = "delete from 负责人表 Where 负责人='" & del_data & "'" '定义删除sql语句
With del_conn
.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
.Open
.Execute del_sql '执行删除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox "删除成功"
Adodc1.Refresh '刷新显示结果
DataGrid1.Refresh
Exit Sub
删除失败错误:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count '控件取消锁定可录入数据
Text1(i - 1).Text = ""
Text1(i - 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus '第一个控件获得焦点
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then '判断是否为修改状态
MsgBox "需要修改数据，请先进入修改状态"
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound '获取选择记录的数据
Text1(i).Text = DataGrid1.Columns(i).Text
Next i
'解除锁定（数据可编辑）
For i = 0 To Text1.UBound
Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text '主键赋值
End Sub
Private Sub Form_Load() '窗体加载
frm_title = "负责人管理" '赋值标题到变量
frm_datatype = 5 '设置窗体当前管理数据类型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count '控件锁定不可录入数据
Text1(i - 1).Text = ""
Text1(i - 1).Locked = True
Next i
Adodc1.Refresh '刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer) '文本框获得焦点，背景色修改，选中原有文本
Text1(Index).BackColor = &HFFFF00
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer) '文本框失去焦点设计填充颜色（恢复）
Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer) '根据状态显示不同标题，设置按钮状态
Select Case frmdatatype
Case 1 '添加
Me.Caption = frm_title & "（添加）"
'按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 2 '添加
Me.Caption = frm_title & "（修改）"
'按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 3 '删除
Me.Caption = frm_title
Case 5 '取消
Me.Caption = frm_title
'按钮状态设置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command删除.Enabled = True
key_data = 0
'锁定所有控件
Dim i
For i = 0 To Text1.UBound
Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
'按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command删除.Enabled = False
End Select
End Sub
个人信息
Private Sub Command保存_Click()
If Me.Text1(2).Text <> "" Then
If Me.Text1(2).Text <> "男" And Me.Text1(2).Text <> "女" Then
MsgBox "性别只能输入男或女"
Exit Sub
End If
End If
If MsgBox("是否更新个人信息？", vbYesNo, "提示") = vbYes Then
Me.Adodc1.Recordset.Update
MsgBox "更新完成"
End If
End Sub
Private Sub Form_Load()
Me.Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 账号表 Where 账号='" & login_name & "'"
Me.Adodc1.Refresh '刷新
'显示权限
Check全部任务.Value = CInt(Adodc1.Recordset.Fields("全部任务").Value) * -1
Check任务查看.Value = CInt(Adodc1.Recordset.Fields("任务查看").Value) * -1
Check任务添加.Value = CInt(Adodc1.Recordset.Fields("任务添加").Value) * -1
Check任务更新.Value = CInt(Adodc1.Recordset.Fields("任务更新").Value) * -1
Check任务删除.Value = CInt(Adodc1.Recordset.Fields("任务删除").Value) * -1
Check常见任务管理.Value = CInt(Adodc1.Recordset.Fields("常见任务管理").Value) * -1
Check负责人管理.Value = CInt(Adodc1.Recordset.Fields("负责人管理").Value) * -1
Check任务类型管理.Value = CInt(Adodc1.Recordset.Fields("任务类型管理").Value) * -1
Check任务状态管理.Value = CInt(Adodc1.Recordset.Fields("任务状态管理").Value) * -1
End Sub
修改密码
Private Sub Command修改密码_Click()
On Error GoTo 操作失败错误
Dim lname As String
Dim opw As String
Dim npw As String
If Trim(Me.Text账号) <> "" Then '判断账号不能为空
lname = Trim(Me.Text账号)
Else
MsgBox "账号不能为空"
Exit Sub
End If
If Trim(Me.Textoldpw) <> "" Then '判断旧密码不能为空
opw = Trim(Me.Textoldpw)
Else
MsgBox "原密码不能为空"
Exit Sub
End If
If Trim(Me.Textnewpw) <> "" Then '判断新密码不能为空
npw = Trim(Me.Textnewpw)
Else
MsgBox "新密码不能为空"
Exit Sub
End If
If opw <> login_pw Then '判断原密码是否正确
MsgBox "原密码不正确"
Exit Sub
End If
If Len(Trim(Me.Textnewpw)) < 6 Then '判断密码长度不能小于6
MsgBox "密码长度不能小于6位！"
Exit Sub
End If
If opw = npw Then '新旧密码不能相同
MsgBox "新密码不能与原密码相同"
Exit Sub
End If
'修改密码操作
Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
With Cnn 'mdb格式连接
.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"
.Open
End With
Dim rs_sql As String
rs_sql = "select * from 账号表 where 账号='" & login_name & "'" '查询该账号记录
rs.Open rs_sql, Cnn, adOpenDynamic, adLockOptimistic
If rs.EOF = False Then '循环表的内容
rs.Fields("密码") = npw
rs.Update
login_pw = npw
MsgBox "修改密码完成"
Else
MsgBox "未找到该账号"
Exit Sub
End If
rs.Close
Set rs = Nothing
Cnn.Close
Set Cnn = Nothing
Exit Sub
操作失败错误:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Me.Text账号 = login_name '显示账号
End Sub
用户注册
