📄 保安巡查.frm
字号:
VERSION 5.00
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form 保安巡查安排
BorderStyle = 1 'Fixed Single
Caption = "保安巡查安排"
ClientHeight = 3450
ClientLeft = 6090
ClientTop = 4290
ClientWidth = 4035
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3450
ScaleWidth = 4035
Begin VB.PictureBox Picture1
BorderStyle = 0 'None
Height = 495
Left = 1680
Picture = "保安巡查.frx":0000
ScaleHeight = 495
ScaleWidth = 495
TabIndex = 9
Top = 600
Width = 495
End
Begin VB.TextBox Txtnumber
Height = 270
Left = 1320
TabIndex = 8
Top = 1320
Width = 2415
End
Begin VB.TextBox Txtname
Height = 270
Left = 1320
TabIndex = 7
Top = 1680
Width = 2415
End
Begin VB.CheckBox Check1
Caption = "执勤"
ForeColor = &H00FF0000&
Height = 255
Left = 120
TabIndex = 6
Top = 2160
Width = 735
End
Begin VB.CheckBox Check2
Caption = "缺勤"
ForeColor = &H000000FF&
Height = 255
Left = 1560
TabIndex = 5
Top = 2160
Width = 735
End
Begin VB.CheckBox Check3
Caption = "请假"
ForeColor = &H000040C0&
Height = 255
Left = 2880
TabIndex = 4
Top = 2160
Width = 735
End
Begin VB.Frame Frame1
Caption = "考勤"
Height = 735
Left = 0
TabIndex = 0
Top = 2640
Width = 3975
Begin CSCommand.Command Cmdexit
Height = 375
Left = 2760
TabIndex = 1
Top = 240
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Icon = "保安巡查.frx":030A
Caption = "退出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command Cmddelete
Height = 375
Left = 1440
TabIndex = 2
Top = 240
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Icon = "保安巡查.frx":115C
Caption = " 撤消"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command Cmdsave
Height = 375
Left = 120
TabIndex = 3
Top = 240
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Icon = "保安巡查.frx":1FAE
Caption = " 保存"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Left = 1440
TabIndex = 10
Top = 0
Width = 2415
_ExtentX = 4260
_ExtentY = 661
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "隶书"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CalendarForeColor= 0
CalendarTitleForeColor= 0
Format = 25690112
CurrentDate = 39548
End
Begin VB.Label Label1
Caption = "值班日期:"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 0
TabIndex = 13
Top = 0
Width = 1455
End
Begin VB.Label Label2
BorderStyle = 1 'Fixed Single
Caption = " 姓 名 :"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 12
Top = 1680
Width = 1215
End
Begin VB.Label Label3
BorderStyle = 1 'Fixed Single
Caption = " 编 号 :"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 11
Top = 1320
Width = 1215
End
End
Attribute VB_Name = "保安巡查安排"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim objcn As Connection
Dim objman As Recordset
Dim objduty As Recordset
Dim isadding As Boolean
'撤消选择考勤情况
Private Sub Cmddelete_Click()
If Check1.Value = 1 Or Check2.Value = 1 Or Check3.Value = 1 Then
Check1.Value = 0
Check2.Value = 0
Check3.Value = 0
End If
End Sub
'退出窗体
Private Sub Cmdexit_Click()
物业管理系统.Show
End Sub
'保存考勤信息
Private Sub Cmdsave_Click()
isadding = True
With objduty
If .RecordCount > 0 Then '已有记录情况下
.MoveFirst
.Find "编号='" & Trim(Txtnumber.Text) & "'"
If (isadding And Not .EOF) Then '查找记录是存在
If .Fields("考勤日期") = DTPicker1.Value Then '判断是否当日重复输入记录
MsgBox "此人考勤情况已经记录!", vbCritical, "温馨提示"
Exit Sub
Else
If (isadding And Not .EOF) Then
If Check1.Value = 1 Then
.Fields("执勤") = .Fields("执勤") + 1
ElseIf Check2.Value = 1 Then
.Fields("缺勤") = Val(.Fields("缺勤")) + 1
ElseIf Check3.Value = 1 Then
.Fields("请假") = Val(.Fields("请假")) + 1
End If
.Fields("考勤日期") = DTPicker1.Value
.Update
MsgBox "更新数据保存成功!", vbInformation, "温馨提示"
End If
End If
Else
If isadding Then .AddNew '新记录的录入
.Fields("考勤日期") = DTPicker1.Value
.Fields("编号") = Txtnumber.Text
.Fields("姓名") = Txtname.Text
If Check1.Value = 1 Then
.Fields("执勤") = 1
.Fields("缺勤") = 0
.Fields("请假") = 0
ElseIf Check2.Value = 1 Then
.Fields("执勤") = 0
.Fields("缺勤") = 1
.Fields("请假") = 0
ElseIf Check3.Value = 1 Then
.Fields("执勤") = 0
.Fields("缺勤") = 0
.Fields("请假") = 1
End If
.Fields("考勤日期") = DTPicker1.Value
.Update
MsgBox "新数据保存成功!", vbInformation, "温馨提示"
isadding = False
End If
Else
If isadding Then .AddNew '首条记录的录入
.Fields("考勤日期") = DTPicker1.Value
.Fields("编号") = Txtnumber.Text
.Fields("姓名") = Txtname.Text
If Check1.Value = 1 Then
.Fields("执勤") = 1
.Fields("缺勤") = 0
.Fields("请假") = 0
ElseIf Check2.Value = 1 Then
.Fields("执勤") = 0
.Fields("缺勤") = 1
.Fields("请假") = 0
ElseIf Check3.Value = 1 Then
.Fields("执勤") = 0
.Fields("缺勤") = 0
.Fields("请假") = 1
End If
.Fields("考勤日期") = DTPicker1.Value
.Update
MsgBox "首条数据保存成功!", vbInformation, "温馨提示"
isadding = False
End If
End With
End Sub
Private Sub Form_Load()
'获得当前日期
DTPicker1.Value = Format(Now(), "yyyy-mm-dd")
'建立数据库联接
Set objcn = New Connection '实例化联接对象
With objcn '建立数据库联接
.Provider = "SQLOLEDB"
.ConnectionString = "User ID=sa;PWD=sa;Data Source=(local);" & _
"Initial Catalog=物业管理系统"
.Open
End With
'获取小区工作人员信息
Set objman = New Recordset
With objman
Set .ActiveConnection = objcn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open "select * from 小区工作人员信息 where 工种 = '保安人员'"
End With
'获取考勤信息
Set objduty = New Recordset
With objduty
Set .ActiveConnection = objcn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open "select * from 考勤表 "
End With
Dim MyDate, MyWeekDay
MyDate = DTPicker1.Value ' 指定一日期。
MyWeekDay = Weekday(MyDate) ' MyWeekDay 的值为 4，因为 MyDate 是星期四。
Select Case MyWeekDay
Case 1
a = "星期日"
Picture1.Picture = LoadPicture("ico\number\7.ICO")
Case 2
a = "星期一"
Picture1.Picture = LoadPicture("ico\number\1.ICO")
Case 3
a = "星期二"
Picture1.Picture = LoadPicture("ico\number\2.ICO")
Case 4
a = "星期三"
Picture1.Picture = LoadPicture("ico\number\3.ICO")
Case 5
a = "星期四"
Picture1.Picture = LoadPicture("ico\number\4.ICO")
Case 6
a = "星期五"
Picture1.Picture = LoadPicture("ico\number\5.ICO")
Case 7
a = "星期六"
Picture1.Picture = LoadPicture("ico\number\6.ICO")
End Select
With objman
If .RecordCount > 0 Then
.MoveFirst
.Find "值班日期='" & a & "'"
Txtnumber.Text = .Fields("编号")
Txtname.Text = .Fields("姓名")
End If
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -