📄 frmlldj-a.frm

📁 适合于中小型企业管理
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbTH.SetFocus
            MsgBox "请正确填选图号、品名规格！"
            Exit Sub
        End If
        CmbPM.Text = Mrc!品名
        TxtGG.Text = Mrc!规格
        Mrc.Close
End If

If Trim(CmbCK1.Text) = "" Then
        CmbCK1.SetFocus
        MsgBox "请正确填选仓库名称！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_仓库列表 where 仓库名称 = '" & CmbCK1.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbCK1.SetFocus
            MsgBox "请正确填选仓库名称！"
            Exit Sub
        End If
        TxtSql = ""
        Mrc.Close
End If

If Trim(CmbCK2.Text) = "" Then
        CmbCK2.SetFocus
        MsgBox "请正确填选仓库名称！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_仓库列表 where 仓库名称 = '" & CmbCK2.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbCK2.SetFocus
            MsgBox "请正确填选仓库名称！"
            Exit Sub
        End If
        Mrc.Close
End If
If Mrc.State <> adStateClosed Then Mrc.Close
Set Mrc = Nothing

If Trim(TxtLyj.Text) = "" Or Trim(TxtLej.Text) = "" Then
    MsgBox "填写数量错误！"
    TxtLyj.SetFocus
    Exit Sub
End If
    
    If AddFlg = True Then  '添加
        
        SqlTxt = "INSERT INTO Sc_领料表(员工姓名,部门名称,工序名称,图号,领一级,领二级,领料日期,仓库名称1,仓库名称2,创建者) VALUES ('" & TxtYGXM.Text _
        & "', '" & CJMC & "', '" & CmbGX.Text & "', '" & CmbTH.Text & "', '" & TxtLyj.Text & "','" & TxtLej.Text & "','" & DTPLlrq.Value & "','" & CmbCK1.Text & "','" & CmbCK2.Text _
        & "','" & Xtczy & "')"
        CmdExe.CommandText = SqlTxt
        CmdExe.Execute
        MsgBox "记录添加成功！", vbInformation
       
    Else                '修改
    
        SqlTxt = "Update Sc_领料表 Set 员工姓名='" & TxtYGXM.Text & "',部门名称='" & CJMC & "',工序名称='" & CmbGX.Text & "',图号='" & CmbTH.Text _
        & "',领一级='" & TxtLyj.Text & "',领二级='" & TxtLej.Text & "',领料日期='" & DTPLlrq.Value & "',仓库名称1='" & CmbCK1.Text & "',仓库名称2='" & CmbCK2.Text _
        & "',创建者='" & Xtczy & "' WHERE (ID=" & Lablsh.Caption & ")"
        
        CmdExe.CommandText = SqlTxt
        CmdExe.Execute
        MsgBox "记录修改成功！", vbInformation
            
    End If
    
    Call ToolList
    Call Toolfbjzt
    tv.SetFocus
End Sub

Private Sub Command5_Click()
    Call Toolfbjzt
End Sub

Private Sub Form_Load()
    SSTab1.Tab = 0
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , "  ID", 800
    lstContracts.ColumnHeaders.Add , , "部门名称", 1100
    lstContracts.ColumnHeaders.Add , , "员工姓名", 1100
    lstContracts.ColumnHeaders.Add , , "工序", 750
    lstContracts.ColumnHeaders.Add , , "  图号", 1200
    lstContracts.ColumnHeaders.Add , , "  品名", 1300
    lstContracts.ColumnHeaders.Add , , "    规格", 1400
    lstContracts.ColumnHeaders.Add , , "领一级", 900
    lstContracts.ColumnHeaders.Add , , "领二级", 900
    lstContracts.ColumnHeaders.Add , , "领料日期", 1200
    lstContracts.ColumnHeaders.Add , , "  仓库1", 1100
    lstContracts.ColumnHeaders.Add , , "  仓库2", 1100
    
    Set CmdExe = New ADODB.Command
    CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
     
    Set Rs = New ADODB.Recordset
    DTPLlrq.Value = Date
    '添加部门列表
    Dim topNode As Node
    Dim Rsbj As ADODB.Recordset
    Set Rsbj = New ADODB.Recordset
    Rsbj.Open "select 部门名称 from Bs_部门分类  where 生产部门=1 order by 部门名称", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    Do While Not Rsbj.EOF
        Set topNode = tv.Nodes.Add(, , "A" & CStr(Rsbj!部门名称), Rsbj!部门名称, "Root")
        topNode.Tag = Rsbj!部门名称
        
        LoadChild (Rsbj!部门名称)
        
        Rsbj.MoveNext
    Loop
    Rsbj.Close
    
    '添加品名列表
    Dim RsPm As ADODB.Recordset
    Set RsPm = New ADODB.Recordset
    RsPm.Open "select 图号,品名,规格 from Bs_产品图号 order by 图号", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    CmbTH.Clear
    CmbPM.Clear
    Do While Not RsPm.EOF
        CmbTH.AddItem RsPm!图号
        CmbPM.AddItem RsPm!品名
        RsPm.MoveNext
    Loop
    RsPm.Close

    '添加工序列表
    Dim RsPZ As ADODB.Recordset
    Set RsPZ = New ADODB.Recordset
    RsPZ.Open "select 工序名称 from Bs_生产流程 order by 工序名称", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    CmbGX.Clear
    Do While Not RsPZ.EOF
        CmbGX.AddItem RsPZ!工序名称
        RsPZ.MoveNext
    Loop
    RsPZ.Close
    '添加仓库列表
    Dim Rsck As ADODB.Recordset
    Set Rsck = New ADODB.Recordset
    Rsck.Open "select 仓库名称 from Bs_仓库列表 order by 仓库名称", Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
    CmbCK1.Clear
    CmbCK2.Clear
    Do While Not Rsck.EOF
        CmbCK1.AddItem Rsck!仓库名称
        CmbCK2.AddItem Rsck!仓库名称
        Rsck.MoveNext
    Loop
    Rsck.Close
    
    Dim RsJcqx As ADODB.Recordset
    
    
    CmbTH.Text = "请选择"
    CmbPM.Text = "请选择"
End Sub

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

Private Sub lstContracts_ItemClick(ByVal Item As MSComctlLib.ListItem)
If LConRs.State = adStateClosed Then
    MsgBox "没有可选择的数据！", vbCritical, "错误："
    Exit Sub
End If
    With LConRs
        If .RecordCount <> 0 Then
            If Trim(lstContracts.SelectedItem.Text) <> "" Then
                .MoveFirst
                .Find "ID=" & Trim(lstContracts.SelectedItem.Text)
            TxtYGXM.Text = !员工姓名
            CBJ = !部门名称
            CmbGX.Text = !工序名称
            CmbTH.Text = !图号
            CmbPM.Text = !品名
            TxtGG.Text = !规格
            TxtLyj.Text = !领一级
            TxtLej.Text = !领二级
            DTPLlrq.Value = !领料日期
            CmbCK1.Text = !仓库名称1
            CmbCK2.Text = IIf(IsNull(!仓库名称2) = True, !仓库名称1, !仓库名称2)
            Lablsh.Caption = !Id
            
            Command2.Enabled = True
            Command3.Enabled = True
            End If
        End If
    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)
        LabSM.Caption = "员工姓名"
        TxtYGXM.Text = Node.Tag
        YGXM = Node.Tag
        CJMC = Node.Parent.Tag
        
        Command1.Enabled = True
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = False
        Command5.Enabled = False
        
        TxtYGXM.Enabled = False
        TxtLyj.Enabled = False
        TxtLej.Enabled = False
        CmbGX.Enabled = False
        CmbTH.Enabled = False
        CmbPM.Enabled = False

            TxtGG.Text = ""
            TxtLyj.Text = ""
            TxtLej.Text = ""
            DTPLlrq.Value = Date
            Lablsh.Caption = ""
        DTPLlrq.Enabled = False
        DTPLlrq.Value = Date
        
        Dim ItmX As ListItem
    
        Set LConRs = New ADODB.Recordset
        LConRs.Open "select Sc_领料表.ID,工序名称,Sc_领料表.图号,品名,规格,部门名称,员工姓名,领一级,仓库名称1,领二级,仓库名称2,领料日期,Sc_领料表.创建者 from Sc_领料表 inner join Bs_产品图号 on Sc_领料表.图号=Bs_产品图号.图号 where 员工姓名= '" & TxtYGXM.Text & "' and  部门名称 = '" & CJMC & "' order by 领料日期 desc", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
        If Not LConRs.BOF Then LConRs.MoveFirst
        lstContracts.ListItems.Clear
        Do While Not LConRs.EOF
            Set ItmX = lstContracts.ListItems.Add(, , LConRs!Id)
             ItmX.SubItems(1) = LConRs!部门名称
             ItmX.SubItems(2) = LConRs!员工姓名
             ItmX.SubItems(3) = LConRs!工序名称
             ItmX.SubItems(4) = LConRs!图号
             ItmX.SubItems(5) = LConRs!品名
             ItmX.SubItems(6) = LConRs!规格
             ItmX.SubItems(7) = LConRs!领一级
             ItmX.SubItems(8) = LConRs!领二级
             ItmX.SubItems(9) = LConRs!领料日期
             ItmX.SubItems(10) = LConRs!仓库名称1
             ItmX.SubItems(11) = LConRs!仓库名称2
            LConRs.MoveNext
        Loop
        If Not LConRs.EOF Then LConRs.MoveFirst
        lstContracts.Refresh
        
    ElseIf Left(Node.Key, 1) = "A" Then    '车间
        CBJ = Right(Node.Key, Len(Node.Key) - 1)
        LabSM.Caption = "部门名称"
        TxtYGXM.Text = Node.Tag
        CJMC = Node.Tag
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = False
        Command5.Enabled = False
        Command6.Enabled = False
        Command7.Enabled = False
        Command8.Enabled = False
        Command9.Enabled = False
        
        lstContracts.ListItems.Clear
            
            TxtGG.Text = ""
            TxtLyj.Text = ""
            TxtLej.Text = ""
            DTPLlrq.Value = Date
            Lablsh.Caption = ""
    End If

End Sub

Private Sub TxtLyj_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) Then
       KeyAscii = 0
    End If
End Sub

Private Sub TxtLej_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) Then
       KeyAscii = 0
    End If
End Sub

Private Sub Toolbjzt()                                   'Toolbar状态(编辑状态)
        TxtYGXM.Enabled = True
        TxtLyj.Enabled = True
        TxtLej.Enabled = True
        CmbGX.Enabled = True
        CmbTH.Enabled = True
        CmbPM.Enabled = True
        DTPLlrq.Enabled = True
        
        tv.Enabled = False
        lstContracts.Enabled = False
        
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = True
        Command5.Enabled = True
        
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
        TxtYGXM.Enabled = False
        TxtLyj.Enabled = False
        TxtLej.Enabled = False
        CmbGX.Enabled = False
        CmbTH.Enabled = False
        CmbPM.Enabled = False
        DTPLlrq.Enabled = False
        
        tv.Enabled = True
        lstContracts.Enabled = True
        
        Command1.Enabled = True
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = False
        Command5.Enabled = False
End Sub



Private Sub ToolList()
        Dim ItmX As ListItem
    
        Set LConRs = New ADODB.Recordset
        LConRs.Open "select Sc_领料表.ID,工序名称,Sc_领料表.图号,品名,规格,部门名称,员工姓名,
上一页 1 2 3 45
💿 文件大小 5181 K
👤 上传用户 sunqingyan
📂 所属分类 SQL Server
🏷️ 相关标签

#企业管理
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -