frm_rpt_kaoqin.frm

考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支

'
'                If sTmp <> "" Then
'                strSQL = "insert into Yuanyin(emplyid,yuanyinLX,Djdate,hours,ratifier,makeid,bzsm) values('" & DataGrid1.Columns(0).Text & "','特殊原因','" & DataGrid1.Columns(2).Text & "'," & iHour & ",'" & UserName & "','" & OperID & "','" & sTmp & "')"
'                mDB.ExecuteSQL strSQL
'        strSQL = "update wktmrslt set QueRen=4 where emplyid='" & DataGrid1.Columns(0).Text & "' and caldate='" & DataGrid1.Columns(2).Text & "'"
'      mDB.ExecuteSQL strSQL
'      Toolbar1_ButtonClick Toolbar1.Buttons(3)
'                Else
'
'                Exit Sub
'                End If
'            Case 6
'               With sForm
'                .GetFindV2 "请输入漏刷卡原因备注和工时：", "漏刷卡原因：", "工时："
'                sTmp = .GetFindVar1
'                iHour = Val(.GetFindVar2)
'                End With
'
'                If sTmp <> "" Then
'                strSQL = "insert into Yuanyin(emplyid,yuanyinLX,Djdate,hours,ratifier,makeid,bzsm) values('" & DataGrid1.Columns(0).Text & "','漏刷卡','" & DataGrid1.Columns(2).Text & "'," & iHour & ",'" & UserName & "','" & OperID & "','" & sTmp & "')"
'                mDB.ExecuteSQL strSQL
'        strSQL = "update wktmrslt set QueRen=6 where emplyid='" & DataGrid1.Columns(0).Text & "' and caldate='" & DataGrid1.Columns(2).Text & "'"
'      mDB.ExecuteSQL strSQL
'      Toolbar1_ButtonClick Toolbar1.Buttons(3)
'                Else
'
'                Exit Sub
'                End If
'            Case 7
'               With sForm
'                .GetFindV2 "请输入原因备注或处理建议：", "原因：", "工时："
'                sTmp = .GetFindVar1
'                iHour = Val(.GetFindVar2)
'                End With
'
'                If sTmp <> "" Then
'                strSQL = "insert into Yuanyin(emplyid,yuanyinLX,Djdate,hours,ratifier,makeid,bzsm) values('" & DataGrid1.Columns(0).Text & "','无原因','" & DataGrid1.Columns(2).Text & "'," & iHour & ",'" & UserName & "','" & OperID & "','" & sTmp & "')"
'                mDB.ExecuteSQL strSQL
'        strSQL = "update wktmrslt set QueRen=7 where emplyid='" & DataGrid1.Columns(0).Text & "' and caldate='" & DataGrid1.Columns(2).Text & "'"
'      mDB.ExecuteSQL strSQL
'      Toolbar1_ButtonClick Toolbar1.Buttons(3)
'                Else
'
'                Exit Sub
'                End If
'            Case 9
'
'                strSQL = "select dptname as 部门,empcrdtm.emplyid as 工号,emplyname as 姓名,cdatetime as 时间 from depart,emply,empcrdtm where depart.dptid=emply.dptid and emply.emplyid=empcrdtm.emplyid and emply.emplyid='" & DataGrid1.Columns(0).Text & "' and cdatetime between '" & DTPicker1(0).Value & " 05:01:00' and '" & DTPicker1(1).Value + 1 & "  05:00:00'"         '' order by empcrdtm.emplyid,cdatetime"
'                Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'                Dim frmY As New NM_Bas
'                With frmY
'                    .Caption = DataGrid1.Columns(1).Text & DataGrid1.Columns(2).Text & "--原始考勤记录"
'                    .reload_datagrid adoprimaryRS
'                    .Show vbModal
'                End With
'                Set frmY = Nothing
    
        End Select
    
    End If
    Exit Sub
Err1:
'    MsgBox Err.Description
    DisPlayErr Err, strSQL2
    
End Sub

Private Sub DTPicker1_CloseUp(Index As Integer)
    Dim d As Date
    Dim d1 As Date
    Select Case Index
        Case 0
            d = DTPicker1(0).Value
            'd1 = DateAdd("m", 1, d)
            'DTPicker1(1).Value = DateSerial(Year(d1), Month(d1), 1) - 1
            DTPicker1(1).Value = d
        Case 1
    End Select

End Sub

    ' =====================================================

    ' =====================================================
    ' =====================================================
    ' =====================================================



    ' =====================================================

Private Sub Form_Load()
    Set mDB = New mDB
    mDB.InitDB_RY strconnDR
    '    mDB.InitDB_RY SQLConnDR

    '    SaveSetting "temp", "tempint", "tmpi", 2
    


    'strSQL = "select dptid,dptname from depart"
    strSQL = "select dptid,dptname from depart where ify=1 order by dptname asc"
    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
        
    With DataCombo1
        Set .RowSource = adoprimaryRS
        .BoundColumn = "dptID"
        .ListField = "dptname"
        .Refresh
    End With





    Me.Move 0, 0, width00 - 80, height00 - 80

    'strSQL4 = "select ID,iYear,iMonth,emplyid,emplyname,iFen,iDay from NM_ZaGong where iYear=" & Combo1(0).Text & " and iMonth=" & Combo1(1).Text
    'Set adoprimaryRS4 = mDB.adoprimaryRS(strSQL4)
    '
    '
    ''Reload_DataGrid
    'Toolbar1_ButtonClick Toolbar1.Buttons(3)

    Option1(0).Value = True
    Option2(1).Value = True

    sFldString = GetSqlString()
    DTPicker1(0).Value = DateSerial(Year(Date), Month(Date), 1)
    DTPicker1(1).Value = Date

End Sub




Private Sub Form_Resize()
    If Me.height < 2000 Then Exit Sub
    '    DataList1.Top = 1200
    '    Label1.Left = 2175 + 360
    '    Label1.width = 40
    '    DataList1.width = Label1.Left - DataList1.Left
    '    DataList1.height = Me.height - 1200 - 600
    '    Label1.height = DataList1.height
    Frame1.width = Me.width - 300 - 2060
    DataGrid1.Move 100, 1440, Frame1.width + 2060, Me.height - 1880
    '    DataGrid1.Left = Label1.Left + Label1.width
    '    DataGrid1.height = DataList1.height
    '    DataGrid1.Top = DataList1.Top
    '    DataGrid1.width = Me.width - DataGrid1.Left - 400
    '
    ''DataGrid1.Move 120, 960, Me.width - 300, Me.height - 1500
End Sub

    ' =====================================================

    
    ' =====================================================

Private Sub Form_Unload(Cancel As Integer)
    mDB.KillDB
    Set mDB = Nothing
End Sub




Private Sub Text1_DblClick()

    If Text1.Text <> "" Then
        strSQL = "select a.dptname as 部门,b.emplyid as 工号,b.emplyname as 姓名 from depart a,emply b where a.dptid=b.dptid and (a.dptname like '%" & Text1.Text & "%' or b.emplyid  like '%" & Text1.Text & "%' or b.emplyname like '%" & Text1.Text & "%')"
    Else
        strSQL = "select dptname as 部门,emplyid as 工号,emplyname as 姓名 from depart a,emply b where a.dptid=b.dptid"     '''' and dptname like %'" & Text1.Text & "'% or emplyid  like %'" & Text1.Text & "'% or emplyname like %'" & Text1.Text & "'%"
    End If

    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    Set frmX = New NM_Bas
    With frmX
        .reload_datagrid adoprimaryRS
        .Show vbModal
    End With
    Set frmX = Nothing


End Sub

Private Sub frmX_GG()
    ''    frmX.Hide
    '    With adoprimaryRS
    '                Dim varBmk As Variant
    '                For Each varBmk In frmX.DataGrid1.SelBookmarks
    '                    .Bookmark = varBmk
    ''                    .Fields(2) = .Fields(2) + 23
    '                    strSQL2 = "insert into NMJ_Gongxu(cjID,iYear,iMonth,proc_name,price) values(" & ChejianID & "," & Combo1(0).Text & "," & Combo1(1).Text & ",'" & .Fields(1).Value & "'," & .Fields(0).Value & ")"
    '                    mDB.ExecuteSQL (strSQL2)
    '                Next
    '    End With
    'Reload_DataGrid


    With frmX.DataGrid1
        '        Dim varBmk As Variant
        '        For Each varBmk In .SelBookmarks
        '            .Row = varBmk - 1
        ''                    .Fields(2) = .Fields(2) + 23
        '            strSQL2 = "insert into NM_ZaGong(ID,iYear,iMonth,emplyid,emplyname) values(" & .Columns(0).Text & "," & Combo1(0).Text & "," & Combo1(1).Text & ",'" & .Columns(1).Text & "','" & .Columns(2).Text & "')"
        ''Debug.Print strSQL2
        '
        '            mDB.ExecuteSQL (strSQL2)
        '        Next
        Text1.Text = .Columns(1).Text
        
    End With
    
    Toolbar1_ButtonClick Toolbar1.Buttons(3)
    Unload frmX

    'Reload_DataGrid


End Sub

Private Sub Text1_GotFocus()
    If Option1(1).Value = False Then
        Option1(1).Value = True
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error GoTo Err1

    Select Case Button.Index
        Case 1
            '
            'If DataList1.BoundText = "" Then
            'MsgBox "请选择班组。"
            'Exit Sub
            'End If
            '
            'Dim sTmp As String
            ''Dim iPrice As Single
            'With sForm
            '    .GetFindV "请录入员工工号：", "员工工号："
            '    sTmp = .GetFindVar1
            ''    iPrice = .GetFindVar2
            'End With
            '
            'If sTmp <> "" Then
            'strSQL = "select emplyname from lz_emply2 where emplyid='" & sTmp & "'"
            'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
            'If adoprimaryRS.RecordCount Then
            'Dim stmpE As String
            '    stmpE = adoprimaryRS.Fields("emplyname").Value
            '
            'strSQL = "insert into NM_ZaGong(ID,iYear,iMonth,emplyid,emplyname) values(" & DataList1.BoundText & "," & Combo1(0).Text & "," & Combo1(1).Text & ",'" & sTmp & "','" & stmpE & "')"
            'mDB.ExecuteSQL strSQL
            'DataList1_Click
            '
            'End If
            'End If

        Case 2
            'Dim tDate As Date
            'tDate = DateSerial(Combo1(0).Text, Combo1(1).Text, 1)
            'strSQL = "select a.ID as 组号,a.emplyid as 工号,a.emplyname as 姓名,b.Banzu as 班组  from NM_ZaGong a,NM_Place b  where a.ID=b.ID  and a.iYear=" & Year(DateAdd("m", -1, tDate)) & " and a.iMonth=" & Month(DateAdd("m", -1, tDate))
            'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
            '
            'Set frmX = New NM_Bas
            'With frmX
            '    .Caption = "复制上月收发、杂工名单资料"
            '    .Reload_DataGrid adoprimaryRS
            '    .Show vbModal
            'End With

            Dim frmY As New Frm_Rpt_KaoQinFld
            With frmY
                .Show vbModal
            End With
            Set frmY = Nothing
            sFldString = GetSqlString
            Toolbar1_ButtonClick Toolbar1.Buttons(3)

        Case 3

            'strSQL = "select * from NMJ_SfSP where iYear=" & Combo1(0).Text & " and iMonth=" & Combo1(1).Text
            'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
            'If adoprimaryRS.RecordCount Then
            '    If adoprimaryRS.Fields("HeFlg3").Value <> 0 And adoprimaryRS.Fields("JsFlg").Value <> 0 Then
            '    Check1(0).Value = 1
            '    Check1(1).Value = 1
            '    Label3(0).Caption = "已审批"
            '    Label3(3).Caption = "已结算"
            '    Toolbar1.Buttons(1).Enabled = False
            '    Toolbar1.Buttons(2).Enabled = False
            '    Toolbar1.Buttons(4).Enabled = False