frmmonth.frm

这是温州现代集团的员工考勤管理系统

            If Trim(txtEmp) <> Empty Then
                If tmpStr <> Empty Then
                    tmpStr = tmpStr & "的员工"
                End If
                tmpStr = tmpStr & Trim(txtEmp)
            End If
            
            If optKq(mNORMAL).Value Then
                tmpStr = tmpStr & "正常考勤"
            End If
            If optKq(mABNORMAL).Value Then
                tmpStr = tmpStr & "非正常考勤"
            End If
            If optKq(mALL).Value Then
                tmpStr = tmpStr & "全部考勤"
            End If
            tmpStr = tmpStr & "的记录"
            
            PrintGridNormal gOwnName & "-" & Me.Caption, _
                msfGrid, 1, tmpStr, True
        Case 2
            Unload Me
    End Select
End Sub

Private Function CheckQryIsExist() As Boolean
    Dim tmpTableName As String
    tmpTableName = Right(Year(Date), 2) & Val(cboMonth.Text)
    mSelQryName = gQRY & tmpTableName
    If HasThisQuery(mSelQryName) Then
        Me.Caption = Year(Date) & "年" _
            & Format(Val(cboMonth.Text), _
            "00") & "月  " & mMonthStr
        CheckQryIsExist = True
    Else
        CheckQryIsExist = False
    End If
End Function

Private Sub Command2_Click()
    Dim Frm As frmLookMan
    Set Frm = New frmLookMan
    With Frm
        .Show vbModal
        txtEmp = .mWorkNo
    End With
End Sub

Private Sub Form_Load()
    SetGridColor msfGrid
    msfGrid.FormatString = mFormatString
    With cboMonth
        .Clear
        Dim I As Integer
        For I = 1 To Month(Date)
            .AddItem Format(I, "00") & " 月"
        Next
        .ListIndex = Month(Date) - 1
    End With
    With cboDept
        .Clear
        FillCbo cboDept, aDepartment, 0
    End With
'gPlanTableName
End Sub

Private Function FindPlan() As Boolean
    Dim intDeptID As Integer
    Dim strWorkNo As String
    Dim strDept As String
    Dim WhereFlag As Boolean
    Dim Str As String
    Dim intRows As Integer
    
    'On Error GoTo FindErr
    getItemData cboDept, intDeptID
    strDept = Trim(cboDept.Text)
    strWorkNo = Trim(txtEmp)
    
    mSql = "select * from " & mSelQryName 'gPlanQryName
    If strWorkNo <> Empty Then
        mSql = mSql & JoinSqlStr(strWorkNo, WhereFlag, "WorkNo", True)
    End If
    If intDeptID <> gMAXITEM Then mSql = mSql & JoinSqlStr(intDeptID, WhereFlag, "DeptID", False)
    mSql = mSql & " order by WorkNo,F_Day"
    Set mRst = gDataBase.OpenRecordset(mSql)
    Dim IsContinue As Boolean
    Dim IntShift As Integer
    'Dim strWorkNo As String
    Dim strDate As String
    Dim strKqTime As String
    Dim blnNormal As Boolean
    Dim blnIsAll As Boolean
    Dim blnIsNormal As Boolean
    'Dim intRows As Long
    blnIsAll = (optKq(mALL).Value = True)
    blnIsNormal = (optKq(mNORMAL).Value = True)
    
    With mRst
        While Not .EOF
            IsContinue = True
            IntShift = !ID
            strWorkNo = Trim(!WorkNo)
            strKqTime = Empty
            strDate = Year(Date) & "-" _
                & Format(Month(Date), "00") & "-" _
                & Format(CStr(!F_Day), "00")
                
            blnNormal = IsNormal(IntShift, strWorkNo, strDate, strKqTime)
            If blnIsAll Then
                IsContinue = True
            Else
                If blnIsNormal Then
                    If Not blnNormal Then IsContinue = False
                Else
                    If blnNormal Then IsContinue = False
                End If
            End If
            
            If IsContinue Then
                intRows = intRows + 1
                Str = Str & strWorkNo & vbTab & _
                    IIf(IsNull(!Name), "", Trim(!Name)) & vbTab
                intDeptID = !DeptID
                Str = Str & GetDept(intDeptID) & vbTab _
                    & !F_Day & vbTab
                    
                If blnIsAll Then
                    If blnNormal Then
                        GetNormalKq Str, IntShift, strKqTime
                    Else
                        GetAbNormal Str, IntShift, strKqTime, strDate, strWorkNo
                    End If
                Else
                    If blnIsNormal Then '正常
                        GetNormalKq Str, IntShift, strKqTime
                    Else '非正常
                        GetAbNormal Str, IntShift, strKqTime, strDate, strWorkNo
                    End If
                End If
                If Not .EOF Then Str = Str & vbCr
            End If
            .MoveNext
        Wend
    End With
    intRows = intRows + msfGrid.FixedRows
    ClipToGrid msfGrid, Str, intRows, mGridCols
    With msfGrid
        .MergeCells = flexMergeRestrictRows
        .MergeCol(mWorkNo) = True
        .MergeCol(mName) = True
        .MergeCol(mDept) = True
    End With
    FindPlan = True
    Exit Function
FindErr:
    MsgBox mMsg3 & vbCrLf & Err.Description, vbCritical, gTitle
    stbMsg.Panels(1).Text = mMsg3
    FindPlan = False
    Err.Clear
    Me.Enabled = True
    Me.MousePointer = 0
End Function

Private Sub GetAbNormal(Str As String, IntShift As Integer, strKqTime As String, strDate As String, strWorkNo As String)
    Select Case IntShift
        Case gNOSHIFT '未排班
            Str = Str & gNOSHIFTNAME & vbTab
        Case GSHIFTLEAVEID, GSHIFTEVECTIONID, GSHIFTMONEYID
            If IntShift = GSHIFTLEAVEID Then '请假
                Str = Str & GSHIFTLEAVESTR & vbTab
                GetNote Str, True, strDate, strWorkNo, False
            Else
                If IntShift = GSHIFTEVECTIONID Then '出差
                    Str = Str & GSHIFTEVECTIONSTR & vbTab
                    GetNote Str, False, strDate, strWorkNo, True
                ElseIf IntShift = GSHIFTMONEYID Then '有薪假期
                    Str = Str & GSHIFTMONEYSTR & vbTab
                    GetNote Str, False, strDate, strWorkNo, False
                End If
            End If
        Case Else
            If strKqTime <> Empty Then '迟到
                Str = Str & gWORKLATE & vbTab & strKqTime
            Else '旷工
                Str = Str & gNOTINWORK & vbTab
            End If
    End Select
End Sub

Private Sub GetNote(Str As String, isLeave As Boolean, strDate As String, strWorkNo As String, isEvection As Boolean)
    Dim Sql As String
    Dim WhereFlag As Boolean
    Sql = Sql & "select StartTime,EndTime,StartDate,EndDate from "
    If isLeave Then
        Sql = Sql & "Leave"
        WhereFlag = False
    Else
        Sql = Sql & "Absent"
        Sql = Sql & " Where IsEvection="
        If isEvection Then
            Sql = Sql & gTRUE
        Else
            Sql = Sql & gFALSE
        End If
        WhereFlag = True
    End If
    If WhereFlag Then
        Sql = Sql & " and "
    Else
        Sql = Sql & " Where "
    End If
    Sql = Sql & " WorkNo='" & strWorkNo _
        & "' and StartDate<='" & strDate _
        & "' and EndDate>='" & strDate & "'" _
        & " and F_DelFlag=" & gFALSE _
        & " order by StartTime"
    Dim Rst As Recordset
    Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    If Rst.RecordCount > 0 Then
        With Rst
            If strDate = Trim(!StartDate) And strDate = Trim(!EndDate) Then '在同一天之内
                Str = Str & mSTARTTIMESTR & Trim(!StartTime) _
                    & Space(1) & mENDTIMESTR & Trim(!EndTime)
            Else
                If strDate = Trim(!StartDate) Then '此天等于起始日期
                    Str = Str & mSTARTTIMESTR & Trim(!StartTime) _
                        & Space(1) & mTOSTR & Space(1) & mOUTWORKSTR
                ElseIf strDate = Trim(!EndDate) Then '此天等于截至日期
                    Str = Str & mINWORKSTR & Space(1) _
                        & mTOSTR & Space(1) & mENDTIMESTR & Trim(!EndTime)
                Else '当中
                    Str = Str & mWHOLEDAYSTR
                End If
            End If
        End With
    Else
        Str = Str & mMsg4
    End If
    Rst.Close
    Set Rst = Nothing
End Sub
Private Sub GetNormalKq(Str As String, IntShift As Integer, strKqTime As String)
    If IntShift = GSHIFTRESTID Then '休息
        Str = Str & GSHIFTRESTSTR & vbTab
    Else '正常出勤
        Str = Str & gNORMALKQSTR & vbTab & strKqTime
    End If
End Sub

Private Function IsNormal(IntShift As Integer, strWorkNo As String, strDate As String, strKqTime As String) As Boolean
    If IntShift = GSHIFTRESTID Then
        IsNormal = True
        Exit Function
    Else
        If IsNormalKq(IntShift, strWorkNo, strDate, strKqTime) Then
            IsNormal = True
            Exit Function
        End If
    End If
    IsNormal = False
End Function

Private Function GetDept(intDeptID As Integer) As String
    Dim I As Integer
    For I = 0 To UBound(aDepartment)
        With aDepartment(I)
            If .ID = intDeptID Then
                GetDept = Trim(.Name)
                Exit Function
            End If
        End With
    Next
    GetDept = Empty
End Function