frmprn.frm

一个用VB开发的考勤管理系统... 希望大家来看看..提出见意.. 谢谢.

        & "<部 门   |^起始日期     |" _
        & "^起始时间  |^截至日期     |" _
        & "^截止时间  |<请假类型 |" _
        & "<批准人   |<事由       "
Const mLEAVECOLS = 10
Const mFRSABSENT = "^工号  |<姓名       |" _
        & "<部 门       |^起始日期       |" _
        & "^起始时间    |^截止日期       |" _
        & "^截止时间    |<批准人         "
Const mABSENTCOLS = 8
Const mFRSNOTINWORK = "^工号                 |<姓名                  |" _
        & "<部 门                   |" _
        & "^日 期                             "
Const mNOTINWORKCOLS = 4
Dim mGridCols As Integer

'************OPTKQ
Const mNORMAL = 0
Const mLATE = 1
Const mNOTINWORK = 2
Const mLEAVE = 3
Const mEVECTION = 4
Const mMONEY = 5


Private Sub cboDept_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeyTab KeyCode
    End If
End Sub
'
Private Sub cmdSel_Click(Index As Integer)
    frmRiLi.Show vbModal
    If frmRiLi.mRetDate <> Empty Then
        txtDate(Index) = frmRiLi.mRetDate
    End If
End Sub
'
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0
            If Trim(txtDate(0)) > Trim(txtDate(1)) Then
                MsgBox Trim(Label1(0)) & "不能大于" & Trim(Label1(1)), vbInformation, gTitle
                txtDate(0).SetFocus
                Exit Sub
            End If
            FindDetail
            Command1(1).Enabled = msfGrid.Rows > msfGrid.FixedRows
        Case 1
            Dim tmpStr As String
            If Trim(cboDept.Text) <> gALLDEPTNAME Then
                tmpStr = Trim(cboDept.Text)
            End If
            If Trim(txtEmp) <> Empty Then
                If tmpStr <> Empty Then
                    tmpStr = tmpStr & "的员工"
                End If
                tmpStr = tmpStr & Trim(txtEmp)
            End If
            
            If Trim(txtDate(0)) <> Trim(txtDate(1)) Then
                tmpStr = tmpStr & "在" & Trim(txtDate(0)) _
                    & "至" & Trim(txtDate(1)) & "期间"
            Else
                tmpStr = tmpStr & "在" & Trim(txtDate(0))
            End If
            
            Dim I As Integer
            For I = 0 To optKq.Count - 1
                If optKq(I).Value Then
                    tmpStr = tmpStr & Trim(optKq(I).Caption)
                    If I = mNORMAL Then tmpStr = tmpStr & "考勤" '正常两个自晦涩不清
                End If
            Next
            
            tmpStr = tmpStr & "记录"
            
            PrintGridNormal gOwnName & "-" & Me.Caption, _
                msfGrid, 1, tmpStr, True
        Case 2
            Unload Me
    End Select
End Sub

'
Private Sub FindDetail()
    Dim StartDate As String
    Dim EndDate As String
    Dim intDept As Integer
    Dim strDept As String
    Dim strWorkNo As String
    Dim Sql As String
    Dim IsKq As Boolean
    Dim isLeave As Boolean
    Dim IsAbsent As Boolean
    If optKq(mNORMAL).Value Or optKq(mLATE).Value Then IsKq = True
    If optKq(mLEAVE).Value Then isLeave = True
    If optKq(mEVECTION).Value Or optKq(mMONEY).Value Then IsAbsent = True
    
    On Error GoTo FindErr
    StartDate = Trim(txtDate(0))
    EndDate = Trim(txtDate(1))
    getItemData cboDept, intDept
    strDept = Trim(cboDept.Text)
    strWorkNo = Trim(txtEmp)
    
    Sql = " Select * from  "
    If IsKq Then
        Sql = Sql & "QryKqHistory "
    End If
    
    If isLeave Then
        Sql = Sql & "QryLeave"
    End If
    
    If IsAbsent Then
        Sql = Sql & "QryAbsent"
    End If
    
    
    If IsKq Then
        Sql = Sql & " where KqDate between '" & StartDate & "' and '" _
             & EndDate & "'"
        If optKq(mNORMAL).Value Then
            Sql = Sql & " and KqTime<='" & gLATETIME & "'"
        Else
            Sql = Sql & " and KqTime>'" & gLATETIME & "'"
        End If
    End If
    
    If isLeave Or IsAbsent Then
        Sql = Sql & " Where StartDate>='" & StartDate & "' and " _
            & " EndDate<='" & EndDate & "'"
        If IsAbsent Then
            If optKq(mEVECTION).Value Then
                Sql = Sql & " and IsEvection=" & gTRUE
            Else
                Sql = Sql & " and IsEvection=" & gFALSE
            End If
        Else
        End If
    End If
         
    If strWorkNo <> Empty Then
        Sql = Sql & " and " & "InStr(1,WorkNo,'" & strWorkNo & "',0)>0 "
    End If

    If intDept <> gMAXITEM Then Sql = Sql & " and DeptName='" & strDept & "'"
    
    Sql = Sql & " and F_DelFlag=" & gFALSE
    Sql = Sql & " order by Workno,DeptName"
    
    Dim Rst As Recordset
    Dim strIn As String
    Dim intRows As Integer
    Dim intCols As Integer

    Set Rst = gDataBase.OpenRecordset(Sql)
    If Rst.RecordCount > 0 Then
        Do While Not Rst.EOF
            intRows = intRows + 1
            With Rst
                If IsKq Then
                    strIn = strIn & !WorkNo & vbTab _
                        & !Name & vbTab _
                        & !DeptName & vbTab _
                        & !KqDate & vbTab & !KqTime
                End If
                If isLeave Then
                    strIn = strIn & !WorkNo & vbTab _
                        & !Name & vbTab _
                        & !DeptName & vbTab _
                        & !StartDate & vbTab _
                        & !StartTime & vbTab _
                        & !EndDate & vbTab _
                        & !EndTime & vbTab _
                        & !TypeName & vbTab _
                        & !AllowMan & vbTab _
                        & !Reason
                End If
                
                If IsAbsent Then
                    strIn = strIn & !WorkNo & vbTab _
                        & !Name & vbTab _
                        & !DeptName & vbTab _
                        & !StartDate & vbTab _
                        & !StartTime & vbTab _
                        & !EndDate & vbTab _
                        & !EndTime & vbTab _
                        & !AllowMan
                End If

                If Not .EOF Then strIn = strIn & vbCr
                .MoveNext
            End With
        Loop
        Rst.Close
    Else
        MsgBox "没有符合条件的记录", vbInformation, gTitle
    End If
    intRows = intRows + 1
    If IsKq Then intCols = mKQCOLS
    If isLeave Then intCols = mLEAVECOLS
    If IsAbsent Then intCols = mABSENTCOLS

    Dim I As Integer
    With msfGrid
        ClipToGrid msfGrid, strIn, intRows, intCols
        .MergeCells = flexMergeRestrictRows
        For I = 0 To 2
            .MergeCol(I) = True
        Next
    End With
    Exit Sub
FindErr:
    MsgBox Err.Description, vbInformation, gTitle
    Err.Clear
End Sub

Private Sub Command2_Click()
    With frmLookMan
        .Show vbModal
        txtEmp = .mWorkNo
    End With
End Sub
'
Private Sub Form_Load()
    SetGridColor msfGrid
    
    msfGrid.FormatString = mFRSKQ
    txtDate(0) = Format(Now, "yyyy-mm-dd")
    txtDate(1) = Format(Now, "yyyy-mm-dd")
    With cboDept
        .Clear
        FillCbo cboDept, aDepartment, 0
    End With
    optKq(mNORMAL).Value = True
End Sub

Private Sub optKq_Click(Index As Integer)
    With msfGrid
        .Rows = .FixedRows
        .Cols = 1
        Select Case Index
            Case mNORMAL, mLATE
                .FormatString = mFRSKQ
                mGridCols = mKQCOLS
            Case mNOTINWORK
                .FormatString = mFRSNOTINWORK
                mGridCols = mNOTINWORKCOLS
            Case mLEAVE
                .FormatString = mFRSLEAVE
                mGridCols = mLEAVECOLS
            Case mEVECTION, mMONEY
                .FormatString = mFRSABSENT
                mGridCols = mABSENTCOLS
        End Select
    End With
End Sub

'
'
Private Sub txtDate_GotFocus(Index As Integer)
    GotFocus txtDate(Index)
End Sub

Private Sub txtDate_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeyTab KeyCode
    End If
End Sub