frm_bas_depart.frm

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

Private adoprimaryRS   As ADODB.Recordset
Private adoPrimaryRS2  As ADODB.Recordset
Private adoPrimaryRS3  As ADODB.Recordset
Private adoprimaryRS4  As ADODB.Recordset

Dim mDB As mDB





Private Sub datagrid1_HeadClick(ByVal intColIndex As Integer)
    '   'Sort by clicked column
    '   With adoprimaryRS
    '     .Sort = .Fields(ColIndex).Name & " ASC"
    '   End With
    '   DataGrid1.Refresh
    Static px As Integer
    px = px + 1
    'Sort by clicked column
    With adoprimaryRS
        If px Mod 2 = 0 Then
            .Sort = .Fields(intColIndex).Name & " ASC"
        Else
            .Sort = .Fields(intColIndex).Name & " DESC"
        End If
    
    End With
    DataGrid1.Refresh



End Sub

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeys "{tab}"
    End If

End Sub

Private Sub Reload_Datalist()
    '    'Dim DmDB As New mDB
    '    'DmDB.InitDB_SQL "Zjxy", "xinya", "reformer", "5148936"
    '    strSQL = "select * from E_TblCL"
    '    Set adoprimaryRS = DmDB.adoprimaryRS(strSQL)
    '    Debug.Print adoprimaryRS.RecordCount
    '    With DataList1
    '        Set .RowSource = adoprimaryRS
    '        .BoundColumn = "tblID"
    '        .ListField = "tblMC"
    '        .ReFill
    '    End With
    '    'Set DmDB = Nothing

End Sub
'''''''''''''=======================================================================

Private Sub DataGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim Index As Integer
    Dim yRow As Integer
    Dim sTmp
    On Error Resume Next

    Index = DataGrid1.ColContaining(X)
    yRow = DataGrid1.RowContaining(Y)


    If Button = vbRightButton Then
        Dim ltmp As Long
        'ltmp = oMenu.PopUp("过滤", "=过滤", "like过滤条件", "3列过滤", "2列过滤")
        'ltmp = oMenu.Popup("过滤", "like过滤条件", "2列过滤", "3列过滤", ">", "<", "-", "收发明细（按订单）")
        ltmp = oMenu.Popup("like过滤条件")
        Dim Scode As String
        Dim iTmp As Single


        Select Case ltmp
            Case 1

                'adoPrimaryRS4.Filter = DataGrid1.Columns(Index).Caption & "='" & DataGrid1.Columns(Index).Text & "'"
                '
                'Case 2
                '''''''''''''==================
                sTmp = InputBox("请输入过滤条件。", "NewAsia")
                If Len(sTmp) Then
                    adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & " like '" & sTmp & "%'"
                End If

                'ElseIf ltmp = 4 Then
                '
                'adoPrimaryRS2.Filter = DataGrid1.Columns(index - 1).Caption & "='" & DataGrid1.Columns(index - 1).Text & "' and " & DataGrid1.Columns(index).Caption & "='" & DataGrid1.Columns(index).Text & "' and " & DataGrid1.Columns(index + 1).Caption & "='" & DataGrid1.Columns(index + 1).Text & "'"
                '
                'ElseIf ltmp = 5 Then
                '
                'adoPrimaryRS2.Filter = DataGrid1.Columns(index).Caption & "='" & DataGrid1.Columns(index).Text & "' and " & DataGrid1.Columns(index + 1).Caption & "='" & DataGrid1.Columns(index + 1).Text & "'"

            Case 3
                adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & "='" & DataGrid1.Columns(Index).Text & "' and " & DataGrid1.Columns(Index + 1).Caption & "='" & DataGrid1.Columns(Index + 1).Text & "'"

            Case 4

                adoprimaryRS.Filter = DataGrid1.Columns(Index - 1).Caption & "='" & DataGrid1.Columns(Index - 1).Text & "' and " & DataGrid1.Columns(Index).Caption & "='" & DataGrid1.Columns(Index).Text & "' and " & DataGrid1.Columns(Index + 1).Caption & "='" & DataGrid1.Columns(Index + 1).Text & "'"

            Case 5
                'Dim iTmp As Integer
                iTmp = InputBox("请输入过滤的数字：", "范围过滤：", 0, X, Y)

                adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & ">=" & iTmp     ''''  sMan & "' or " & DataGrid1.Columns(4).Caption & "= '" & sMan & "'"
            Case 6
                iTmp = InputBox("请输入过滤的数字：", "范围过滤：", 0, X, Y)

                adoprimaryRS.Filter = DataGrid1.Columns(Index).Caption & "<" & iTmp     ''''  sMan & "' or " & DataGrid1.Columns(4).Caption & "= '" & sMan & "'"
            Case 8
                'DataCombo1.Text = DataGrid1.Columns(0).Text
                'Command1_Click 0
                'DataCombo1.Text = ""

        End Select

        'If ltmp > 0 And ltmp < 7 Then
        'Text1(4).Text = Sum_RsFld(adoPrimaryRS4, "收")
        'Text1(5).Text = Sum_RsFld(adoPrimaryRS4, "过程余量")
        'End If

    End If
End Sub



Private Sub List1_Click()
    'On Error Resume Next

    Select Case List1.ListIndex + 1
        Case 1
            strSQL = "select dptid,dptparent,dptno,dptname as 部门名称,managerID as 经理工号,manager as 经理,Email as 邮箱,Phone as 电话,Fax as 传真,Adress as 地址 from Depart order by dptparent,dptid"
'Debug.Print SQLConnDR


    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Debug.Print adoprimaryRS.RecordCount
    
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS
        .Columns(0).width = 0
        .Columns(1).width = 0
        .Columns(2).width = 0
        .Columns(3).width = 2000
            
        .AllowAddNew = False
        .AllowDelete = False
        .Refresh
    End With
        Case 2
            strSQL = "select holidayid as 序号,holidaydecs as 请假类型 from holidaykind"
    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS
        .AllowAddNew = True
        .AllowDelete = True
        .Refresh
    End With
        Case 3
            strSQL = "select evectionid as 序号,evectiondecs as 出差类型 from evectionkind"
    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS
        .AllowAddNew = True
        .AllowDelete = True
        .Refresh
    End With
        Case 4
'        strSQL = "select JR_Date as 节假日 from CC_JRDate"

                strSQL = "select dptid as 序号,dptparent as 部门序号,dptno as 部门号,dptname as 部门名称,managerID as 经理工号,manager as 经理,Email as 邮箱,Phone as 电话,Fax as 传真,Adress as 地址 from Depart order by dptparent,dptid"
'Debug.Print SQLConnDR


    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Debug.Print adoprimaryRS.RecordCount
    
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS
'        .Columns(0).width = 0
'        .Columns(1).width = 0
'        .Columns(2).width = 0
        .Columns(3).width = 2000
            
'        .AllowAddNew = False
'        .AllowDelete = False
        .Refresh
    End With

        Case 5
        strSQL = "select JR_Date as 节假日 from CC_JRDate"

'                strSQL = "select dptid as 序号,dptparent as 部门序号,dptno as 部门号,dptname as 部门名称,managerID as 经理工号,manager as 经理,Email as 邮箱,Phone as 电话,Fax as 传真,Adress as 地址 from Depart order by dptparent,dptid"
'Debug.Print SQLConnDR


    Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Debug.Print adoprimaryRS.RecordCount
    
    With DataGrid1
        .ClearFields
        Set .DataSource = adoprimaryRS
'        .Columns(0).width = 0
'        .Columns(1).width = 0
'        .Columns(2).width = 0
'        .Columns(3).width = 2000
            
'        .AllowAddNew = False
'        .AllowDelete = False
        .Refresh
    End With

    End Select


End Sub

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

   
    With List1
        .AddItem "部门资料"
        .AddItem "请假类型"
        .AddItem "出差类型"
        .AddItem "部门资料"
        .AddItem "节假日登记"
'                .AddItem "移动电话EMAIL登记"
        '        .AddItem "档案类别表"
        '        .AddItem "档案来源表"
        '        .AddItem "存放地点表"
        .Refresh
    End With
    
    Me.Move 0, 0, width00 - 80, height00 - 80


End Sub


Private Sub Form_Resize()
    On Error Resume Next
    With Me
        List1.Move 120, 700, 3000, .ScaleHeight - 840
        DataGrid1.Move 3100, 700, Me.width - 3500, ScaleHeight - 840
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'DataList1.SetFocus
    mDB.KillDB
    Set mDB = Nothing

End Sub



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


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

    Select Case Button.Index
        Case 1

            ToExcel.ToExcel adoprimaryRS
            'ToExcel.ToExcel_noFld adoprimaryRS, "A1"

            'ToExcel.ToExcelFlds adoprimaryRS, "部门名称,经理工号,经理,邮箱,电话,地址"

        Case 2
            Unload Me


    End Select

    Exit Sub
Err1:
    MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & Err.Source & vbCrLf & Err.LastDllError & vbCrLf & Err.HelpContext, vbInformation, App.Title & "  -  Advisory"


End Sub