frmaddinout.frm
来自「企业人事管理系统,有考勤,人员管理等功能,值得研究,也是我付费弄来的,绝对超值」· FRM 代码 · 共 381 行
FRM
381 行
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmAddInOutInfo
BorderStyle = 3 'Fixed Dialog
Caption = "添加员工考勤信息"
ClientHeight = 3525
ClientLeft = 45
ClientTop = 330
ClientWidth = 6270
Icon = "frmAddInOut.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3525
ScaleWidth = 6270
ShowInTaskbar = 0 'False
Begin VB.Frame Frame2
Caption = "员工出勤信息"
Height = 1455
Left = 240
TabIndex = 5
Top = 1440
Width = 5655
Begin VB.Frame frame
Caption = "出入信息"
Height = 855
Left = 120
TabIndex = 7
Top = 480
Width = 5295
Begin VB.OptionButton OutFlag
Caption = "下班时间"
Height = 255
Left = 2760
TabIndex = 9
Top = 360
Width = 1215
End
Begin VB.OptionButton InFlag
Caption = "上班时间"
Height = 255
Left = 120
TabIndex = 8
Top = 300
Width = 1095
End
Begin MSComCtl2.DTPicker dtpBT
Height = 375
Left = 1320
TabIndex = 14
Top = 240
Width = 1215
_ExtentX = 2143
_ExtentY = 661
_Version = 393216
Format = 41943042
CurrentDate = 38074
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Left = 3960
TabIndex = 15
Top = 240
Width = 1215
_ExtentX = 2143
_ExtentY = 661
_Version = 393216
Format = 41943042
CurrentDate = 38074
End
End
Begin MSComCtl2.DTPicker dtpET
Height = 270
Left = 2400
TabIndex = 12
Top = 240
Width = 1335
_ExtentX = 2355
_ExtentY = 476
_Version = 393216
Format = 41943041
CurrentDate = 38074
End
Begin VB.Label Label4
Caption = "当前日期："
Height = 255
Left = 1200
TabIndex = 6
Top = 240
Width = 1095
End
End
Begin VB.Frame Frame1
Caption = "员工个人信息"
Height = 615
Left = 240
TabIndex = 1
Top = 600
Width = 5655
Begin VB.TextBox txtName
Height = 270
Left = 3960
TabIndex = 13
Top = 240
Width = 1455
End
Begin VB.TextBox txtID
Height = 270
Left = 1440
TabIndex = 4
Top = 240
Width = 1335
End
Begin VB.Label Label3
Caption = "员工姓名："
Height = 270
Left = 3000
TabIndex = 3
Top = 240
Width = 1215
End
Begin VB.Label Label2
Caption = "员工编号："
Height = 270
Left = 360
TabIndex = 2
Top = 240
Width = 975
End
End
Begin MSForms.CommandButton cmdExit
Height = 375
Left = 3600
TabIndex = 11
Top = 3000
Width = 1095
Caption = "返回"
PicturePosition = 327683
Size = "1931;661"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdOK
Height = 375
Left = 960
TabIndex = 10
Top = 3000
Width = 1095
Caption = "确定"
PicturePosition = 327683
Size = "1931;661"
Picture = "frmAddInOut.frx":0442
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label topic
Alignment = 2 'Center
Caption = "添加员工上下班信息"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1440
TabIndex = 0
Top = 120
Width = 3255
End
End
Attribute VB_Name = "frmAddInOutInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private ilate As Integer '迟到次数
Private iearly As Integer '早退次数
Private aflag As String '出入标志
Private Sub cmdExit_Click()
Unload Me
End Sub
'添加上下班信息
Private Sub cmdOk_Click()
Dim sql As String
Dim sql2 As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
Dim strmsg2 As String
Dim rsTime As New ADODB.Recordset
Dim tmsetswsb, tmsetswxb, tmsetxwsb, tmsetxwxb As Date
Dim tmsb1, tmxb1 As Date
sql = "select * from AttendanceInfo order by ID desc"
sql2 = "select * from TimeSetting"
Set rs = ExecuteSQL(sql, strMsg)
Set rsTime = ExecuteSQL(sql2, strmsg2)
'添加上班信息
If InFlag = False And OutFlag = False Then
MsgBox "请选择上下班", vbOKOnly + vbExclamation, "警告!"
End If
If InFlag = True Then
If txtID.Text = "" Or txtName.Text = "" Then
MsgBox "要添加上班信息,员工编号与姓名不能为空,请输入", vbOKOnly, "提示"
Exit Sub
End If
'判断上下午上班时间是否迟到
tmsb1 = dtpBT.Value
h = Hour(tmsb1)
m = Minute(tmsb1)
s = Second(tmsb1)
tmsb1 = CDate(h & ":" & m & ":" & s)
tmsetswsb = CDate(rsTime.Fields("上午上班时间"))
tmsetswxb = CDate(rsTime.Fields("上午下班时间"))
tmsetxwsb = CDate(rsTime.Fields("下午上班时间"))
'判断上午上班时间是否迟到
If tmsb1 < tmsetswxb Then
If tmsb1 > tmsetswsb Then
ilate = 1
MsgBox "迟到"
Else
ilate = 0
MsgBox "正常上班"
End If
'判断下午上班时间是否迟到
Else
If tmsb1 > tmsetxwsb Then
ilate = 1
MsgBox "迟到"
Else
ilate = 0
MsgBox "正常上班"
End If
End If
aflag = "入"
rs.AddNew
rs.Fields("工号") = txtID.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("当前日期") = dtpET.Value
rs.Fields("上班时间") = dtpBT.Hour & ":" & dtpBT.Minute & ":" & dtpBT.Second
rs.Fields("出入标志") = aflag
rs.Fields("迟到次数") = ilate
rs.Update
rs.Close
MsgBox "已完成添加上班信息", vbOKOnly + vbInformation, "添加结果！"
Unload Me
Exit Sub
End If
'添加下班信息
If OutFlag = True Then
If txtID.Text = "" Or txtName.Text = "" Then
MsgBox "要添加下班信息,员工编号与姓名不能为空,请输入", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
'判断上下午下班时间是否早退
tmxb1 = DTPicker1.Value
h = Hour(tmxb1)
m = Minute(tmxb1)
s = Second(tmxb1)
tmxb1 = CDate(h & ":" & m & ":" & s)
tmsetxwsb = CDate(rsTime.Fields("下午上班时间"))
tmsetswxb = CDate(rsTime.Fields("上午下班时间"))
tmsetxwxb = CDate(rsTime.Fields("下午下班时间"))
'判断上午下班时间
If tmxb1 < tmsetxwsb Then
If tmxb1 < tmsetswxb Then
iearly = 1
MsgBox "早退"
Else
iearly = 0
MsgBox "正常下班"
End If
'判断下午下班时间
Else
If tmxb1 < tmsetxwxb Then
iearly = 1
MsgBox "早退"
Else
iearly = 0
MsgBox "正常下班"
End If
End If
aflag = "出"
rs.AddNew
rs.Fields("工号") = txtID.Text
rs.Fields("姓名") = txtName.Text
rs.Fields("当前日期") = dtpET.Value
rs.Fields("下班时间") = DTPicker1.Hour & ":" & DTPicker1.Minute & ":" & DTPicker1.Second
rs.Fields("出入标志") = aflag
rs.Fields("早退次数") = iearly
rs.Update
rs.Close
MsgBox "已完成添加下班信息", vbOKOnly + vbInformation, "添加结果！"
Unload Me
Exit Sub
End If
End Sub
Private Sub Form_Load()
dtpET.Value = Date '初始化为当天时间
dtpBT.Value = Time
DTPicker1.Value = Time
End Sub
Private Sub txtName_Validate(Cancel As Boolean) 'Validate 表示失去焦点之前发生的事件
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
sql = "select * from t_br where 姓名= '" & txtName & "'"
Set rs = ExecuteSQL(sql, strMsg)
If rs.BOF Or rs.EOF Then
MsgBox "无记录或此姓名不存在", vbOKOnly + vbExclamation, "警告"
'txtID.Text = ""
txtName.Text = ""
txtName.SetFocus
Exit Sub
Else
txtID.Text = rs.Fields("工号")
txtName.Text = rs.Fields("姓名")
End If
End Sub
Private Sub txtID_Validate(Cancel As Boolean) 'Validate 表示失去焦点之前发生的事件
Dim sql As String
Dim rs As New ADODB.Recordset
Dim strMsg As String
sql = "select * from t_br where 工号= '" & txtID & "'"
Set rs = ExecuteSQL(sql, strMsg)
If rs.BOF Or rs.EOF Then
MsgBox "无记录或此工号不存在", vbOKOnly + vbExclamation, "警告"
txtID.Text = ""
'txtName.Text = ""
txtID.SetFocus
Exit Sub
Else
txtID.Text = rs.Fields("工号")
txtName.Text = rs.Fields("姓名")
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?