【每日任務(wù)管理系統(tǒng)】(2) VB 管理系統(tǒng) 代碼分享 Visual Basic 編程 程序 Access數(shù)據(jù)
窗體
全部任務(wù)
Dim dh As Long? '存儲高度差
Dim dw As Long? '存儲寬度差
Private Sub Command查詢1_Click()? ? '單條件查詢
On Error GoTo 結(jié)束查詢
Dim search_field As String
If 查詢字段 = "任務(wù)日期" Then
? ? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
? ? ? ? search_field = 查詢字段
? ? ? ? rw_filter = search_field & " between #" & 起始日期 & "# and #" & 截止日期 & "#"
? ? Else
? ? ? ? rw_filter = ""
? ? End If
? ? Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
? ? Adodc1.Refresh
? ? DataGrid1.Refresh
? ? DataGrid1.SetFocus
? ? Exit Sub
End If
If 查詢字段 = "倒計時天數(shù)" Then
? ? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
? ? ? ? search_field = 查詢字段
? ? ? ? rw_filter = search_field & " >= " & 最小 & " And " & search_field & " <= " & 最大
? ? Else
? ? ? ? rw_filter = ""
? ? End If
? ? Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
? ? Adodc1.Refresh
? ? DataGrid1.Refresh
? ? DataGrid1.SetFocus
? ? Exit Sub
End If
If 查詢內(nèi)容 <> "" And IsNull(查詢內(nèi)容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
? ? search_field = 查詢字段
? ? rw_filter = search_field & " like '%" & 查詢內(nèi)容 & "%'"
Else
? ? rw_filter = ""
End If
? ? Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
? ? Adodc1.Refresh
? ? DataGrid1.Refresh
? ? DataGrid1.SetFocus
? ? Exit Sub
結(jié)束查詢:
? ? MsgBox Err.Description
End Sub
Private Sub Command管理_Click()
On Error GoTo A1
rw_num = DataGrid1.Columns(0).Text
frm任務(wù)管理.Show 1
A1:
End Sub
Private Sub Command降序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " DESC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
rw_filter = ""
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command升序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " ASC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command生成報表_Click()
DataReport任務(wù)明細報表.DataMember = ""
With DataEnvironment1
.Commands(1).CommandType = adCmdText
.Commands(1).CommandText = "SHAPE {" & 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order) & "}? AS Command任務(wù)查詢 APPEND ({SELECT * FROM 明細查詢}? AS Command明細查詢 RELATE '任務(wù)ID' TO '任務(wù)ID') AS Command明細查詢"
.Commands(1).Execute ("SHAPE {" & 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order) & "}? AS Command任務(wù)查詢 APPEND ({SELECT * FROM 明細查詢}? AS Command明細查詢 RELATE '任務(wù)ID' TO '任務(wù)ID') AS Command明細查詢")
If .rsCommand任務(wù)查詢.State = 1 Then
? ? .rsCommand任務(wù)查詢.Close
End If
Set DataReport任務(wù)明細報表.DataSource = DataEnvironment1
DataReport任務(wù)明細報表.DataMember = "Command任務(wù)查詢"
End With
'打開報表
DataReport任務(wù)明細報表.Show 1
End Sub
Private Sub Command添加_Click()
If 任務(wù)添加權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm任務(wù)添加.Show 1
End Sub
Private Sub Form_Load()
'篩選排序變量清空
rw_filter = ""
rw_order = "任務(wù)ID DESC"
查詢內(nèi)容.Visible = True
'--隱藏日期控件
起始日期.Visible = False
截止日期.Visible = False
'--隱藏金額控件
最小.Visible = False
最大.Visible = False
'標簽
Label查詢內(nèi)容.Visible = True
'--隱藏日期控件
Label起始日期.Visible = False
Label截止日期.Visible = False
'--隱藏金額控件
Label最小.Visible = False
Label最大.Visible = False
'ado控件設(shè)置
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"
Adodc1.CommandType = adCmdUnknown
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh? ? '刷新
'存儲數(shù)據(jù)表格控件與窗體寬高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
End Sub
Function 生成查詢語句(ByVal searchtb As String, ByVal searchfilter As String, ByVal searchorder As String) As String
生成查詢語句 = ""
Dim sqltext As String
sqltext = "Select * From " & searchtb
If searchfilter <> "" Then
sqltext = sqltext & " where " & searchfilter
End If
If searchorder <> "" Then
sqltext = sqltext & " order by " & searchorder
End If
生成查詢語句 = sqltext
End Function
Private Sub Form_Resize()
'窗體大小變化表格控件尺寸改變
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub 查詢字段_Click()
If 查詢字段 = "任務(wù)日期" Then
起始日期.Visible = True
截止日期.Visible = True
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = False
起始日期.Value = Date
截止日期.Value = Date
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = True
End If
If 查詢字段 = "倒計時天數(shù)" Then
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = True
最大.Visible = True
查詢內(nèi)容.Visible = False
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = True
End If
A1:
'標簽
If 查詢字段 = "任務(wù)日期" Then
Label起始日期.Visible = True
Label截止日期.Visible = True
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = True
End If
If 查詢字段 = "倒計時天數(shù)" Then
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = True
Label最大.Visible = True
Label查詢內(nèi)容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = True
End If
a2:
End Sub
任務(wù)查詢
Dim dh As Long? '存儲高度差
Dim dw As Long? '存儲寬度差
Private Sub Command查詢1_Click()? ? '單條件查詢
On Error GoTo 結(jié)束查詢
Dim search_field As String
If 查詢字段 = "任務(wù)日期" Then
? ? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
? ? ? ? search_field = 查詢字段
? ? ? ? rw_filter = search_field & " between #" & 起始日期 & "# and #" & 截止日期 & "#" & " and 創(chuàng)建賬號 ='" & login_name & "'"
? ? Else
? ? ? ? rw_filter = "創(chuàng)建賬號 ='" & login_name & "'"
? ? End If
? ? Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
? ? Adodc1.Refresh
? ? DataGrid1.Refresh
? ? DataGrid1.SetFocus
? ? Exit Sub
End If
If 查詢字段 = "倒計時天數(shù)" Then
? ? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
? ? ? ? search_field = 查詢字段
? ? ? ? rw_filter = search_field & " >= " & 最小 & " And " & search_field & " <= " & 最大 & " and 創(chuàng)建賬號 ='" & login_name & "'"
? ? Else
? ? ? ? rw_filter = "創(chuàng)建賬號 ='" & login_name & "'"
? ? End If
? ? Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
? ? Adodc1.Refresh
? ? DataGrid1.Refresh
? ? DataGrid1.SetFocus
? ? Exit Sub
End If
If 查詢內(nèi)容 <> "" And IsNull(查詢內(nèi)容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
? ? search_field = 查詢字段
? ? rw_filter = search_field & " like '%" & 查詢內(nèi)容 & "%'" & " and 創(chuàng)建賬號 ='" & login_name & "'"
Else
? ? rw_filter = "創(chuàng)建賬號 ='" & login_name & "'"
End If
? ? Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
? ? Adodc1.Refresh
? ? DataGrid1.Refresh
? ? DataGrid1.SetFocus
? ? Exit Sub
結(jié)束查詢:
? ? MsgBox Err.Description
End Sub
Private Sub Command管理_Click()
On Error GoTo A1
rw_num = DataGrid1.Columns(0).Text
frm任務(wù)管理.Show 1
A1:
End Sub
Private Sub Command降序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " DESC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
rw_filter = "創(chuàng)建賬號 ='" & login_name & "'"
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command升序_Click()
If 排序 <> "" And IsNull(排序) = False Then
rw_order = 排序 & " ASC"
Else
rw_order = ""
End If
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command生成報表_Click()
DataReport任務(wù)明細報表.DataMember = ""
With DataEnvironment1
.Commands(1).CommandType = adCmdText
.Commands(1).CommandText = "SHAPE {" & 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order) & "}? AS Command任務(wù)查詢 APPEND ({SELECT * FROM 明細查詢}? AS Command明細查詢 RELATE '任務(wù)ID' TO '任務(wù)ID') AS Command明細查詢"
.Commands(1).Execute ("SHAPE {" & 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order) & "}? AS Command任務(wù)查詢 APPEND ({SELECT * FROM 明細查詢}? AS Command明細查詢 RELATE '任務(wù)ID' TO '任務(wù)ID') AS Command明細查詢")
If .rsCommand任務(wù)查詢.State = 1 Then
? ? .rsCommand任務(wù)查詢.Close
End If
Set DataReport任務(wù)明細報表.DataSource = DataEnvironment1
DataReport任務(wù)明細報表.DataMember = "Command任務(wù)查詢"
End With
'打開報表
DataReport任務(wù)明細報表.Show 1
End Sub
Private Sub Command添加_Click()
If 任務(wù)添加權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
frm任務(wù)添加.Show 1
End Sub
Private Sub Form_Load()
'篩選排序變量清空
rw_filter = "創(chuàng)建賬號 ='" & login_name & "'"
rw_order = "任務(wù)ID DESC"
查詢內(nèi)容.Visible = True
'--隱藏日期控件
起始日期.Visible = False
截止日期.Visible = False
'--隱藏金額控件
最小.Visible = False
最大.Visible = False
'標簽
Label查詢內(nèi)容.Visible = True
'--隱藏日期控件
Label起始日期.Visible = False
Label截止日期.Visible = False
'--隱藏金額控件
Label最小.Visible = False
Label最大.Visible = False
'ado控件設(shè)置
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"
Adodc1.CommandType = adCmdUnknown
Adodc1.RecordSource = 生成查詢語句("任務(wù)信息查詢", rw_filter, rw_order)
Adodc1.Refresh? ? '刷新
'存儲數(shù)據(jù)表格控件與窗體寬高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
End Sub
Function 生成查詢語句(ByVal searchtb As String, ByVal searchfilter As String, ByVal searchorder As String) As String
生成查詢語句 = ""
Dim sqltext As String
sqltext = "Select * From " & searchtb
If searchfilter <> "" Then
sqltext = sqltext & " where " & searchfilter
End If
If searchorder <> "" Then
sqltext = sqltext & " order by " & searchorder
End If
生成查詢語句 = sqltext
End Function
Private Sub Form_Resize()
'窗體大小變化表格控件尺寸改變
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub 查詢字段_Click()
If 查詢字段 = "任務(wù)日期" Then
起始日期.Visible = True
截止日期.Visible = True
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = False
起始日期.Value = Date
截止日期.Value = Date
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = True
End If
If 查詢字段 = "倒計時天數(shù)" Then
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = True
最大.Visible = True
查詢內(nèi)容.Visible = False
GoTo A1
Else
起始日期.Visible = False
截止日期.Visible = False
最小.Visible = False
最大.Visible = False
查詢內(nèi)容.Visible = True
End If
A1:
'標簽
If 查詢字段 = "任務(wù)日期" Then
Label起始日期.Visible = True
Label截止日期.Visible = True
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = True
End If
If 查詢字段 = "倒計時天數(shù)" Then
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = True
Label最大.Visible = True
Label查詢內(nèi)容.Visible = False
GoTo a2
Else
Label起始日期.Visible = False
Label截止日期.Visible = False
Label最小.Visible = False
Label最大.Visible = False
Label查詢內(nèi)容.Visible = True
End If
a2:
End Sub
任務(wù)添加
Dim dh As Long? '存儲高度差
Dim dw As Long? '存儲寬度差
Private Sub Text_DblClick(Index As Integer)
If Index = 0 Then
? ?rw_formname = "frm任務(wù)添加"
? ?frm常見任務(wù)選擇.Show 1
End If
If Index = 1 Then? ? ? ?'雙擊輸入日期的文本框
? ?If Text(1) <> "" Then
? ? ? DTPicker1.Value = Text(1)
? ?Else
? ?Text(1) = Date
? ?DTPicker1.Value = Date
? ?End If
? ?DTPicker1.Visible = True? ? ?'顯示日期選擇控件
End If
End Sub
Private Sub Command清空_Click()
Text(0) = ""
Text(1) = ""
Text(2) = ""
Text(3) = ""
Combo1(0) = ""
Combo1(1) = ""
Combo1(2) = ""
Combo1(3) = ""
DTPicker1.Visible = False? ? ? ?'日期控件隱藏
End Sub
Private Sub Command添加_Click()
On Error GoTo 錯誤提示
If 任務(wù)添加權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
'判斷必須輸入數(shù)據(jù)的控件不能為空
If Text(0) = "" Or IsNull(Text(0)) = True Then
MsgBox "任務(wù)名稱值為空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "任務(wù)日期值為空！"
Exit Sub
Else
End If
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 "任務(wù)表", add_conn, adOpenKeyset, adLockOptimistic
? ? ? ?add_rs.AddNew
? ? ? ?On Error Resume Next
? ? ? ? ? ? add_rs!任務(wù)名稱.Value = Text(0)
? ? ? ? ? ? add_rs!任務(wù)日期.Value = Text(1)
? ? ? ? ? ? add_rs!任務(wù)描述.Value = Text(2)
? ? ? ? ? ? add_rs!備注.Value = Text(3)
? ? ? ? ? ? add_rs!創(chuàng)建賬號.Value = login_name
? ? ? ? ? ? add_rs!任務(wù)負責(zé)人.Value = Combo1(0)
? ? ? ? ? ? add_rs!任務(wù)時間.Value = Combo1(1)
? ? ? ? ? ? add_rs!任務(wù)類型.Value = Combo1(2)
? ? ? ? ? ? add_rs!任務(wù)狀態(tài).Value = Combo1(3)
? ? ? ?add_rs.Update
? ? ? ?add_rs.Close
? ? ? ?Set add_rs = Nothing
? ? ? ?add_conn.Close
? ? ? ?Set add_conn = Nothing
? ? ? ?MsgBox "添加完成"
? ? ? ?Call Command清空_Click
? ? ? ?Adodc1.Refresh
? ? ? ?DataGrid1.Refresh
Exit Sub
錯誤提示:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
'ado控件設(shè)置
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 任務(wù)表 where 創(chuàng)建賬號 ='" & login_name & "' Order By 任務(wù)ID DESC"
Me.Adodc1.Refresh? ? '刷新
'
'存儲數(shù)據(jù)表格控件與窗體寬高差值
dh = Me.Height - DataGrid1.Height
dw = Me.Width - DataGrid1.Width
Call 設(shè)置任務(wù)類型選項
Call 設(shè)置任務(wù)狀態(tài)選項
Call 設(shè)置負責(zé)人選項
End Sub
Private Sub Form_Resize()
'窗體大小變化表格控件尺寸改變
If Me.WindowState <> 1 Then
DataGrid1.Height = Me.Height - dh
DataGrid1.Width = Me.Width - dw
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
frm任務(wù)查詢.Adodc1.Refresh
frm任務(wù)查詢.DataGrid1.Refresh
frm全部任務(wù).Adodc1.Refresh
frm全部任務(wù).DataGrid1.Refresh
frm系統(tǒng)主頁.Adodc1.Refresh
frm系統(tǒng)主頁.DataGrid1.Refresh
End Sub
Private Sub DTPicker1_LostFocus()
DTPicker1.Format = dtpCustom? ? '日期格式設(shè)置
Text(1).Text = DTPicker1.Value? '返回選擇的日期值至文本框
DTPicker1.Visible = False? ? ? ?'日期控件隱藏
End Sub
Private Sub Text_LostFocus(Index As Integer)
If Index = 1 Then? ? ? ?'輸入日期的文本框失去焦點
? ?If Text(1).Text <> "" And IsDate(Text(1)) = False Then
? ? ? MsgBox "輸入的數(shù)據(jù)不是日期類型，請重新輸入"
? ? ? Text(1).Text = ""
? ? ? DTPicker1.Value = False
? ? ? Exit Sub
? ?End If
End If
End Sub
Sub 設(shè)置任務(wù)類型選項()
Dim i As Long
'-清除選項
Combo1(2).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任務(wù)類型表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任務(wù)類型 <> "" Then
Combo1(2).AddItem search_rs!任務(wù)類型
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
Sub 設(shè)置任務(wù)狀態(tài)選項()
Dim i As Long
'-清除選項
Combo1(3).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任務(wù)狀態(tài)表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任務(wù)狀態(tài) <> "" Then
Combo1(3).AddItem search_rs!任務(wù)狀態(tài)
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
Sub 設(shè)置負責(zé)人選項()
Dim i As Long
'-清除選項
Combo1(0).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 負責(zé)人表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!負責(zé)人 <> "" Then
Combo1(0).AddItem search_rs!負責(zé)人
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
任務(wù)管理
Private Sub Command更新_Click()
On Error GoTo 更新失敗錯誤
If 任務(wù)更新權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
If MsgBox("是否更新該任務(wù)記錄?", vbOKCancel) <> vbOK Then
Exit Sub
End If
If Text(0) = "" Or IsNull(Text(0)) = True Then
MsgBox "任務(wù)名稱值為空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "任務(wù)日期值為空！"
Exit Sub
Else
End If
'連接數(shù)據(jù)庫并更新
Adodc1.Recordset.Update
MsgBox "更新完成！"
Exit Sub
更新失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command明細刪除_Click()
On Error GoTo D1
If MsgBox("是否刪除該明細記錄？明細ID：" & DataGrid1.Columns(0), vbYesNo) <> vbYes Then
Exit Sub
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
? ? ? ?update_rs.Open "select * From 明細表 where 明細ID=" & DataGrid1.Columns(0), update_conn, adOpenKeyset, adLockOptimistic
? ? ? ?On Error Resume Next
? ? ? ?update_rs.Delete
? ? ? ?update_rs.Close
? ? ? ?Set update_rs = Nothing
? ? ? ?update_conn.Close
? ? ? ?Set update_conn = Nothing
Me.Adodc2.Refresh? ? '刷新
D1:
End Sub
Private Sub Command明細添加_Click()
frm明細添加.Show 1
End Sub
Private Sub Command刪除_Click()
On Error GoTo 刪除失敗錯誤
If 任務(wù)刪除權(quán)限 = False Then
MsgBox "無權(quán)限"
Exit Sub
End If
If MsgBox("是否刪除該任務(wù)記錄?", vbOKCancel) <> vbOK Then
Exit Sub
End If
Adodc1.Recordset.Delete
MsgBox "刪除完成"
Unload Me
Exit Sub
刪除失敗錯誤:
MsgBox Err.Description
End Sub
Private Sub Command未完成_Click()
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
? ? ? ?update_rs.Open "select * From 明細表 where 明細ID=" & DataGrid1.Columns(0), update_conn, adOpenKeyset, adLockOptimistic
? ? ? ?On Error Resume Next
? ? ? ? ? ? update_rs!是否完成.Value = False
? ? ? ?update_rs.Update
? ? ? ?update_rs.Close
? ? ? ?Set update_rs = Nothing
? ? ? ?update_conn.Close
? ? ? ?Set update_conn = Nothing
Me.Adodc2.Refresh? ? '刷新
'Me.DataGrid1.Refresh
End Sub
Private Sub Command已完成_Click()
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
? ? ? ?update_rs.Open "select * From 明細表 where 明細ID=" & DataGrid1.Columns(0), update_conn, adOpenKeyset, adLockOptimistic
? ? ? ?On Error Resume Next
? ? ? ? ? ? update_rs!是否完成.Value = True
? ? ? ?update_rs.Update
? ? ? ?update_rs.Close
? ? ? ?Set update_rs = Nothing
? ? ? ?update_conn.Close
? ? ? ?Set update_conn = Nothing
Me.Adodc2.Refresh? ? '刷新
End Sub
Private Sub Form_Load()
Call 設(shè)置任務(wù)類型選項
Call 設(shè)置任務(wù)狀態(tài)選項
Call 設(shè)置負責(zé)人選項
'ado控件設(shè)置
Me.Adodc1.Refresh? ? '刷新
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = "select * From 任務(wù)表 where 任務(wù)ID=" & rw_num
Me.Adodc1.Refresh? ? '刷新
'
Me.Adodc2.Refresh? ? '刷新
Me.Adodc2.CommandType = adCmdUnknown
Me.Adodc2.RecordSource = "select * From 明細查詢 where 任務(wù)ID=" & rw_num
Me.Adodc2.Refresh? ? '刷新
Me.DataGrid1.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
frm任務(wù)查詢.Adodc1.Refresh
frm任務(wù)查詢.DataGrid1.Refresh
frm全部任務(wù).Adodc1.Refresh
frm全部任務(wù).DataGrid1.Refresh
End Sub
Private Sub DTPicker1_LostFocus()
DTPicker1.Format = dtpCustom? ? '日期格式設(shè)置
Text(1).Text = DTPicker1.Value? '返回選擇的日期值至文本框
DTPicker1.Visible = False? ? ? ?'日期控件隱藏
End Sub
Private Sub Text_DblClick(Index As Integer)
If Index = 1 Then? ? ? ?'雙擊輸入日期的文本框
? ?If Text(1) <> "" Then
? ? ? DTPicker1.Value = Text(1)
? ?Else
? ?Text(1) = Date
? ?DTPicker1.Value = Date
? ?End If
? ?DTPicker1.Visible = True? ? ?'顯示日期選擇控件
End If
End Sub
Private Sub Text_LostFocus(Index As Integer)
If Index = 1 Then? ? ? ?'輸入日期的文本框失去焦點
? ?If Text(1).Text <> "" And IsDate(Text(1)) = False Then
? ? ? MsgBox "輸入的數(shù)據(jù)不是日期類型，請重新輸入"
? ? ? Text(1).Text = ""
? ? ? DTPicker1.Value = False
? ? ? Exit Sub
? ?End If
End If
End Sub
Sub 設(shè)置任務(wù)類型選項()
Dim i As Long
'-清除選項
Combo1(2).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任務(wù)類型表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任務(wù)類型 <> "" Then
Combo1(2).AddItem search_rs!任務(wù)類型
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
Sub 設(shè)置任務(wù)狀態(tài)選項()
Dim i As Long
'-清除選項
Combo1(3).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 任務(wù)狀態(tài)表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!任務(wù)狀態(tài) <> "" Then
Combo1(3).AddItem search_rs!任務(wù)狀態(tài)
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
Sub 設(shè)置負責(zé)人選項()
Dim i As Long
'-清除選項
Combo1(0).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 負責(zé)人表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!負責(zé)人 <> "" Then
Combo1(0).AddItem search_rs!負責(zé)人
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
明細添加
Private Sub Command清空_Click()
Text(0) = ""
Text(2) = ""
Combo1(0) = ""
Option2.Value = True
End Sub
Private Sub Command添加_Click()
On Error GoTo 錯誤提示
If Text(2) = "" Or IsNull(Text(2)) = True Then
MsgBox "明細內(nèi)容值為空！"
Exit Sub
Else
End If
If Text(1) = "" Or IsNull(Text(1)) = True Then
MsgBox "任務(wù)ID值為空！"
Exit Sub
Else
End If
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!任務(wù)ID.Value = Text(1)
? ? ? ? ? ? add_rs!明細時間.Value = Text(0)
? ? ? ? ? ? add_rs!明細內(nèi)容.Value = Text(2)
? ? ? ? ? ? add_rs!明細負責(zé)人.Value = Combo1(0)
? ? ? ? ? ? add_rs!是否完成.Value = CBool(Option1.Value)
? ? ? ?add_rs.Update
? ? ? ?add_rs.Close
? ? ? ?Set add_rs = Nothing
? ? ? ?add_conn.Close
? ? ? ?Set add_conn = Nothing
? ? ? ?MsgBox "添加完成"
? ? ? ?Call Command清空_Click
frm任務(wù)管理.Adodc2.Refresh
frm任務(wù)管理.DataGrid1.Refresh
Exit Sub
錯誤提示:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Text(1).Text = rw_num
Call 設(shè)置負責(zé)人選項
End Sub
Sub 設(shè)置負責(zé)人選項()
Dim i As Long
'-清除選項
Combo1(0).Clear
'-查詢并填充選項
On Error GoTo 查詢失敗錯誤
Dim search_conn As New ADODB.Connection
Dim search_rs As New ADODB.Recordset
With search_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 search_sql As String
search_sql = "Select * From 負責(zé)人表"
search_rs.Open search_sql, search_conn, adOpenDynamic, adLockOptimistic
'
Do While search_rs.EOF = False
If search_rs!負責(zé)人 <> "" Then
Combo1(0).AddItem search_rs!負責(zé)人
End If
search_rs.MoveNext
Loop
'
search_rs.Close
Set search_rs = Nothing
search_conn.Close
Set search_conn = Nothing
Exit Sub
查詢失敗錯誤:
MsgBox Err.Description
End Sub
數(shù)據(jù)庫
每日任務(wù)計劃管理系統(tǒng)后端采用access數(shù)據(jù)庫存儲數(shù)據(jù)，格式為mdb，命名為db_rw，為了保證安全性，數(shù)據(jù)庫設(shè)置加密，密碼為abc123。
?
表
常見任務(wù)表
負責(zé)人表
明細表
任務(wù)表
?
?
任務(wù)類型表
任務(wù)狀態(tài)表
?
表關(guān)系
?
查詢
今日任務(wù)查詢
SELECT 任務(wù)表.任務(wù)ID, 任務(wù)表.任務(wù)名稱, 任務(wù)表.任務(wù)日期, 任務(wù)表.任務(wù)時間, 任務(wù)表.任務(wù)描述, 任務(wù)表.任務(wù)負責(zé)人, 任務(wù)表.任務(wù)類型, 任務(wù)表.任務(wù)狀態(tài), IIf([任務(wù)日期]-Date()>=0,[任務(wù)日期]-Date(),"已超期") AS 倒計時天數(shù), 任務(wù)表.備注, 任務(wù)表.創(chuàng)建賬號
FROM 任務(wù)表
WHERE (((任務(wù)表.任務(wù)日期)=Date()));
?
明細查詢
SELECT 明細表.明細ID, 明細表.任務(wù)ID, 明細表.明細時間, 明細表.明細內(nèi)容, 明細表.明細負責(zé)人, IIf([是否完成]=0,"否","是") AS 已完成, 明細表.是否完成
FROM 明細表;
?
任務(wù)信息查詢
SELECT 任務(wù)表.任務(wù)ID, 任務(wù)表.任務(wù)名稱, 任務(wù)表.任務(wù)日期, 任務(wù)表.任務(wù)時間, 任務(wù)表.任務(wù)描述, 任務(wù)表.任務(wù)負責(zé)人, 任務(wù)表.任務(wù)類型, 任務(wù)表.任務(wù)狀態(tài), IIf([任務(wù)日期]-Date()>=0,[任務(wù)日期]-Date(),"已超期") AS 倒計時天數(shù), 任務(wù)表.備注, 任務(wù)表.創(chuàng)建賬號
FROM 任務(wù)表;
?
