📄 frmstat.frm
字号:
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 7080
TabIndex = 7
Top = 1440
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "旷工:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 5
Left = 4080
TabIndex = 6
Top = 3840
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "休息:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 4
Left = 4080
TabIndex = 5
Top = 3360
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "病假:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 3
Left = 4080
TabIndex = 4
Top = 2880
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "事假:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 2
Left = 4080
TabIndex = 3
Top = 2400
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "早退:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 1
Left = 4080
TabIndex = 2
Top = 1920
Width = 600
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "0"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 6480
TabIndex = 1
Top = 1440
Width = 120
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "迟到:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 4080
TabIndex = 0
Top = 1440
Width = 600
End
Begin VB.Line Line1
X1 = 3240
X2 = 3240
Y1 = 240
Y2 = 7200
End
End
Attribute VB_Name = "FrmStat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Basic_DB, Check_DB, Leave_DB As Database
Dim Basic_TB, Check_TB, Leave_TB As TableDef
Dim Basic_RS, Check_RS, Leave_RS As Recordset
Dim NodeSum, T_Type As Integer
Dim Tstr, TData(10) As String
Private Sub Command1_Click(Index As Integer)
Text1.Text = TData(Index)
End Sub
Private Sub Form_Load()
NodeSum = 0
TreeView1.Nodes.Clear
TreeView1.LineStyle = tvwRootLines
Set Check_DB = OpenDatabase(App.Path + "\DATA\CHECK.mdb")
Set Check_RS = Check_DB.OpenRecordset("考勤总记录表")
If Check_RS.EOF Then
Set nodex1 = TreeView1.Nodes.Add(, , "MyF", "无记录", 1)
Exit Sub
End If
Check_RS.MoveFirst
Do While Check_RS.EOF = False
For X = 1 To TreeView1.Nodes.Count
If "Y" & Year(Check_RS.Fields(0)) = TreeView1.Nodes.Item(X).Key Then Exit For
Next X
If X > TreeView1.Nodes.Count Then
Set nodex1 = TreeView1.Nodes.Add(, , "Y" & Year(Check_RS.Fields(0)), Year(Check_RS.Fields(0)), 1)
End If
For X = 1 To TreeView1.Nodes.Count
If "D" & Year(Check_RS.Fields(0)) & Month(Check_RS.Fields(0)) = TreeView1.Nodes.Item(X).Key Then Exit For
Next X
If X > TreeView1.Nodes.Count Then
Set nodex1 = TreeView1.Nodes.Add("Y" & Year(Check_RS.Fields(0)), tvwChild, "D" & Year(Check_RS.Fields(0)) & Month(Check_RS.Fields(0)), Month(Check_RS.Fields(0)), 1)
End If
Set nodex2 = TreeView1.Nodes.Add("D" & Year(Check_RS.Fields(0)) & Month(Check_RS.Fields(0)), tvwChild, Check_RS.Fields(0), Day(Check_RS.Fields(0)), 1)
Check_RS.MoveNext
Loop
nodex2.EnsureVisible
Check_RS.Close
Check_DB.Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Hide
FrmMain.Show
End Sub
Private Sub TreeView1_Click()
On Error Resume Next
Tstr = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)
If Temp = "无记录" Then Exit Sub
Tstr = TreeView1.SelectedItem.Key
If Left(Tstr, 1) = "Y" Then Exit Sub
If Left(Tstr, 1) = "D" Then Exit Sub
Dispose
End Sub
Private Sub Dispose()
Set Setup_DB = OpenDatabase(App.Path + "\setup.mdb")
Set Setup_RS = Setup_DB.OpenRecordset("参数设定")
T_Type = Setup_RS.Fields(0)
Set Check_DB = OpenDatabase(App.Path + "\data\" + CStr(Year(CDate(Tstr))) + "\" + CStr(Month(CDate(Tstr))) + ".mdb")
Set Check_RS = Check_DB.OpenRecordset(CStr(Day(CDate(Tstr))))
Set Basic_DB = OpenDatabase(App.Path + "\Basic.mdb")
Set Basic_RS = Basic_DB.OpenRecordset("基本信息")
Set Leave_DB = OpenDatabase(App.Path + "\data\Leave.mdb")
Set Leave_RS = Leave_DB.OpenRecordset("请假表")
If T_Type = 1 Then
Basic_RS.MoveFirst
Do While Basic_RS.EOF = False
On Error Resume Next
If Not Check_RS.EOF Then
Check_RS.MoveFirst
Do While Check_RS.EOF = False
If Check_RS.Fields(0) = Basic_RS.Fields(1) Then Exit Do
Check_RS.MoveNext
Loop
End If
If Check_RS.EOF Then
Check_RS.AddNew
Check_RS.Fields(0) = Basic_RS.Fields(1)
Check_RS.Fields(1) = Basic_RS.Fields(2)
If Weekday(CDate(Tstr)) = 1 Or Weekday(CDate(Tstr)) = 7 Then
Check_RS.Fields(5) = "休息"
Else
If Not Leave_RS.EOF Then
Leave_RS.MoveFirst
Do While Leave_RS.EOF = False
If Leave_RS.Fields(0) = Basic_RS.Fields(1) And DateDiff("y", CDate(Leave_RS.Fields(3)), CDate(Tstr)) >= 0 And DateDiff("y", CDate(Leave_RS.Fields(4)), CDate(Tstr)) <= 0 Then
Check_RS.Fields(5) = Leave_RS.Fields(2)
Exit Do
End If
Leave_RS.MoveNext
Loop
If Leave_RS.EOF Then
Check_RS.Fields(5) = "旷工"
End If
Leave_RS.MoveFirst
Else
Check_RS.Fields(5) = "旷工"
End If
End If
Check_RS.Update
End If
Basic_RS.MoveNext
Loop
Else
Dim T_Rest As Integer
Basic_RS.MoveFirst
T_Rest = (CInt(Setup_RS.Fields(15)) + DateDiff("y", CDate(Setup_RS.Fields(14)), Now)) Mod 4
Do While Basic_RS.EOF = False
On Error Resume Next
If Not Check_RS.EOF Then
Check_RS.MoveFirst
Do While Check_RS.EOF = False
If Check_RS.Fields(0) = Basic_RS.Fields(1) Then Exit Do
Check_RS.MoveNext
Loop
End If
If Check_RS.EOF Then
Check_RS.AddNew
Check_RS.Fields(0) = Basic_RS.Fields(1)
Check_RS.Fields(1) = Basic_RS.Fields(2)
If (T_Rest + CInt(Basic_RS.Fields(13))) Mod 4 = 3 Then
Check_RS.Fields(5) = "休息"
Else
If Not Leave_RS.EOF Then
Leave_RS.MoveFirst
Do While Leave_RS.EOF = False
If Leave_RS.Fields(0) = Basic_RS.Fields(1) And DateDiff("y", CDate(Leave_RS.Fields(3)), CDate(Tstr)) >= 0 And DateDiff("y", CDate(Leave_RS.Fields(4)), CDate(Tstr)) <= 0 Then
Check_RS.Fields(5) = Leave_RS.Fields(2)
Exit Do
End If
Leave_RS.MoveNext
Loop
If Leave_RS.EOF Then
Check_RS.Fields(5) = "旷工"
End If
Leave_RS.MoveFirst
Else
Check_RS.Fields(5) = "旷工"
End If
End If
Check_RS.Update
End If
Basic_RS.MoveNext
Loop
End If
For X = 0 To 5
Label2(X).Caption = "0"
TData(X) = ""
Next X
Check_RS.MoveFirst
Do While Check_RS.EOF = False
If Left(Check_RS.Fields(5), 2) = "迟到" Then Label2(0).Caption = CInt(Label2(0).Caption) + 1: TData(0) = TData(0) & Check_RS.Fields(1) & "、"
If Right(Check_RS.Fields(5), 2) = "早退" Then Label2(1).Caption = CInt(Label2(1).Caption) + 1: TData(1) = TData(1) & Check_RS.Fields(1) & "、"
If Check_RS.Fields(5) = "事假" Then Label2(2).Caption = CInt(Label2(2).Caption) + 1: TData(2) = TData(2) & Check_RS.Fields(1) & "、"
If Check_RS.Fields(5) = "病假" Then Label2(3).Caption = CInt(Label2(3).Caption) + 1: TData(3) = TData(3) & Check_RS.Fields(1) & "、"
If Check_RS.Fields(5) = "休息" Then Label2(4).Caption = CInt(Label2(4).Caption) + 1: TData(4) = TData(4) & Check_RS.Fields(1) & "、"
If Check_RS.Fields(5) = "旷工" Then Label2(5).Caption = CInt(Label2(5).Caption) + 1: TData(5) = TData(5) & Check_RS.Fields(1) & "、"
Check_RS.MoveNext
Loop
Label4.Caption = Tstr & "统计如下:"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -