frmygxx.frm

适合于中小型企业管理

            Cxnrrec.CancelBatch adAffectAllChapters
        End If
End Sub

Private Sub Form_Load()
    '调入网格设置信息
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , " ID", 600
    lstContracts.ColumnHeaders.Add , , "员工编号", 1180
    lstContracts.ColumnHeaders.Add , , " 部门名称", 1480
    lstContracts.ColumnHeaders.Add , , " 员工姓名", 1280
    lstContracts.ColumnHeaders.Add , , "  联系电话", 1480
    lstContracts.ColumnHeaders.Add , , "  家庭地址", 1480
    lstContracts.ColumnHeaders.Add , , "  创建者", 1480
    lstContracts.ColumnHeaders.Add , , "  创建日期", 1480
    
    Dim topNode As Node
    Dim Rsbj As ADODB.Recordset
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "select 部门名称 from Bs_部门分类 order by 部门名称", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    tv.Nodes.Clear
    Combo1.Clear
    Do While Not Rsbj.EOF
        Set topNode = tv.Nodes.Add(, , "A" & CStr(Rsbj!部门名称), Rsbj!部门名称, "Root")
        topNode.Tag = Rsbj!部门名称
        
            '填 充 网 格
       ' Call Cxnrtcwg(Rsbj!部门名称)
        LoadChild (Rsbj!部门名称)
        Combo1.AddItem Rsbj!部门名称
        Rsbj.MoveNext
    Loop
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
'    Frame1.Enabled = False
     
    '设置为非录入状态
    Lrzt = 0
   
End Sub

Private Sub loaddata()
    Dim topNode As Node
    Dim Rsbj As ADODB.Recordset
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "select 部门名称 from Bs_部门分类 order by 部门名称", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    tv.Nodes.Clear
    Combo1.Clear
    Do While Not Rsbj.EOF
        Set topNode = tv.Nodes.Add(, , "A" & CStr(Rsbj!部门名称), Rsbj!部门名称, "Root")
        topNode.Tag = Rsbj!部门名称
        
            '填 充 网 格
        Call Cxnrtcwg(Rsbj!部门名称)
        LoadChild (Rsbj!部门名称)
        Combo1.AddItem Rsbj!部门名称
        Rsbj.MoveNext
    Loop
End Sub

Private Sub LoadChild(Lbj As String)
        Dim child As Node
        
        Set Rsyg = New ADODB.Recordset
    
        Rsyg.Open "select * from Bs_员工明细 where 部门名称 = '" & Lbj & "' order by ID", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        Do While Not Rsyg.EOF
            Set child = tv.Nodes.Add("A" & Lbj, tvwChild, "B" & CStr(Rsyg!Id), Rsyg!员工姓名, "Child")
                child.Tag = Rsyg!员工姓名
                
            Rsyg.MoveNext
        Loop
    Set Cxnrrec = New ADODB.Recordset
    Cxnrrec.Open "select * from Bs_员工明细 where 部门名称 = '" & Combo1.Text & "' order by ID", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic, adCmdText
End Sub

Private Sub lstContracts_DblClick()
  Call Xgdqjl
End Sub

Private Sub QxCommand_Click()                                           '取消
    If AddFlg = True Then
      Cxnrrec.CancelUpdate
    Else
      Cxnrrec.CancelBatch adAffectAllChapters
    End If
    
    If Bln_Cancel Then
        Bln_Cancel = False
        Exit Sub
    End If
    
    Call Toolfbjzt
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
      
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            DY_Dyymsz.Show 1
        Case "yl"                                            '预 览
                
        Case "dy"                                            '打 印
            
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            Call Cshlrxx(Lrzt)
            AddFlg = True
            LrText(4).Text = Gsdate()
             LrText(0).Text = Year(GsdateT) & Month(GsdateT) & Day(Gsdate) & Hour(GsdateT) & Minute(GsdateT) & Second(GsdateT)
            Cxnrrec.AddNew
        Case "xg"                                            '修 改
            Call Xgdqjl
        Case "sc"                                            '删 除
            DelFlg = False
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call loaddata
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        End Select
        
End Sub

Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息
    Toolbjzt
    LrText(0).Text = ""
    LrText(1).Text = ""
    LrText(2).Text = ""
    LrText(3).Text = ""
    
End Function

Private Sub Scdqjl()                                     '删 除 当 前 记 录
    Toolfbjzt
     If Not lstContracts.ListItems.Count < 1 Then
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Sc_领料表 where 员工姓名='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(3).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在领料表（普通车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Sc_检验表 where 员工姓名='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(3).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在检验表（普通车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Dm_领料表 where 站机人='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(3).Text) & "' or 擦片人='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(3).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在领料表（镀膜车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        Set RsCsDel = New ADODB.Recordset
        RsCsDel.Open "SELECT count(*) as SumCount FROM Dm_检验表 where 站机人='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(3).Text) & "' or 擦片人='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(3).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel!SumCount > 0 Then
                MsgBox "有" & RsCsDel!SumCount & "条记录在检验表（镀膜车间）！", vbCritical, "特别提醒："
                DelFlg = True
        End If
        RsCsDel.Close
        Set RsCsDel = Nothing
        If DelFlg = True Then Exit Sub
        If vbYes = MsgBox("确认是要删除此记录么？" & "(" & lstContracts.SelectedItem.Text & ")", vbYesNo, "删除对话框") Then
            Sqlstr = "delete FROM Bs_员工明细 where id='" & Trim(lstContracts.SelectedItem.Text) & "'"
            Set RsView = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        End If
    Else
        MsgBox "请选择要删除的记录行！", vbCritical, "错误："
    End If
    
    Call loaddata
End Sub

Private Sub Xgdqjl()                                     '修改当前编码记录
    
    If Not lstContracts.ListItems.Count < 1 Then
        Toolbjzt
        Set Cxnrrec = New ADODB.Recordset
        Cxnrrec.Open "SELECT *  FROM Bs_员工明细 where id='" & Trim(lstContracts.SelectedItem.Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
             LrText(0).Text = Cxnrrec!员工编号
             LrText(1).Text = Cxnrrec!员工姓名
             LrText(2).Text = Cxnrrec!联系电话
             LrText(3).Text = Cxnrrec!家庭地址
             LrText(4).Text = Cxnrrec!创建日期
             Combo1.AddItem Cxnrrec!部门名称
    End If
End Sub

Private Sub Cxnrtcwg(StrBM As String)                                 '查询内容填充网格(刷新)
    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结


    '[>>查询连接串
    Sqlstr = "SELECT * FROM Bs_员工明细 where 部门名称='" & StrBM & "' order by 部门名称,员工姓名"
    '<<]
    Set Jlbrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    

    '[>>以下为自定义部分
    Dim ItmX As ListItem

    lstContracts.ListItems.Clear
    Do While Not Jlbrec.EOF
        Set ItmX = lstContracts.ListItems.Add(, , Jlbrec!Id)
         ItmX.SubItems(1) = Jlbrec!员工编号
         ItmX.SubItems(2) = Jlbrec!部门名称
         ItmX.SubItems(3) = Jlbrec!员工姓名
         ItmX.SubItems(4) = Jlbrec!联系电话
         ItmX.SubItems(5) = Jlbrec!家庭地址
         ItmX.SubItems(6) = Jlbrec!创建者
         ItmX.SubItems(7) = Jlbrec!创建日期
        
        Jlbrec.MoveNext
    Loop

    '以上为自定义部分<<]
  
    '将网格刷新动作解冻
     lstContracts.Refresh
    
End Sub

Private Sub Toolbjzt()                                   'Toolbar状态(编辑状态)

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    tv.Enabled = False
    StTab.TabEnabled(0) = False
  
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("sx").Enabled = False
        
    End With
  
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)

    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    tv.Enabled = True
    StTab.TabEnabled(1) = False
    Lrzt = 0
    
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
    End With
  
End Sub

Private Sub tv_NodeClick(ByVal Node As MSComctlLib.Node)
   On Error Resume Next
   Dim txtSQLBJ As String
    If Left(Node.Key, 1) = "B" Then
        CBJ = Right(Node.Parent.Key, Len(Node.Parent.Key) - 1)
        Combo1.Text = Node.Parent.Tag
        CJMC = Node.Parent.Tag
        YGXM = Node.Tag
        
    ElseIf Left(Node.Key, 1) = "A" Then
        CBJ = Right(Node.Key, Len(Node.Key) - 1)
        Combo1.Text = Node.Tag
        CJMC = Node.Tag
         
         Call Cxnrtcwg(CJMC)
    End If

End Sub