frmlldj.frm

适合于中小型企业管理

      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbZjr.SetFocus
            MsgBox "请正确填选员工姓名！"
            Exit Sub
        End If
        Mrc.Close
End If

If Trim(CmbCpr.Text) = "" Then
        CmbCpr.SetFocus
        MsgBox "请正确填选员工姓名！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_员工明细 where 员工姓名 = '" & CmbCpr.Text & "' and 部门名称='" & CmbBmmc.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbCpr.SetFocus
            MsgBox "请正确填选员工姓名！"
            Exit Sub
        End If
        Mrc.Close
End If

If Trim(CmbTH.Text) = "" Then
        CmbTH.SetFocus
        MsgBox "请正确填选图号、品名规格！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_产品图号 where 图号='" & CmbTH.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      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 dm_领料表(站机人,部门名称,擦片人,图号,领一级,领二级,领料日期,仓库名称1,仓库名称2,创建者) VALUES ('" & CmbZjr.Text _
        & "', '" & CmbBmmc.Text & "', '" & CmbCpr.Text & "', '" & CmbTH.Text & "', '" & TxtLyj.Text & "','" & TxtLej.Text & "','" & DTPLlrq.Value & "','" & CmbCK1.Text & "','" & CmbCK2.Text _
        & "','" & Xtczy & "')"
        CmdExe.CommandText = SqlTxt
        CmdExe.Execute
        MsgBox "记录添加成功！", vbInformation
       
    Else                '修改
        
        SqlTxt = "Update dm_领料表 Set 站机人='" & CmbZjr.Text & "',部门名称='" & CmbBmmc.Text & "',擦片人='" & CmbCpr.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
    Command1.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 , , "擦片人", 1100
    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
        CmbBmmc.AddItem 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 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

    CmbTH.Text = "请选择"
    CmbPM.Text = "请选择"
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)
            CmbZjr.Text = !站机人
            CmbBmmc.Text = !部门名称
            CmbCpr.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 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状态(编辑状态)
        TxtLyj.Enabled = True
        TxtLej.Enabled = True
        CmbBmmc.Enabled = True
        CmbZjr.Enabled = True
        CmbCpr.Enabled = True
        CmbTH.Enabled = True
        CmbPM.Enabled = True
        DTPLlrq.Enabled = True
        
        lstContracts.Enabled = False
        
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = True
        Command5.Enabled = True
        
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
        TxtLyj.Enabled = False
        TxtLej.Enabled = False
        CmbBmmc.Enabled = True
        CmbZjr.Enabled = True
        CmbCpr.Enabled = True
        CmbTH.Enabled = False
        CmbPM.Enabled = False
        DTPLlrq.Enabled = False

        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
    If Trim(CmbZjr.Text) <> "" And Trim(CmbCpr.Text) = "" Then

        LConRs.Open "select Dm_领料表.ID,Dm_领料表.图号,品名,规格,部门名称,站机人,擦片人,领一级,仓库名称1,领二级,仓库名称2,领料日期,Dm_领料表.创建者 from Dm_领料表 inner join Bs_产品图号 on Dm_领料表.图号=Bs_产品图号.图号 where 站机人= '" _
                & CmbZjr.Text & "' and  部门名称 = '" & CmbBmmc.Text & "' 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 Trim(CmbZjr.Text) = "" And Trim(CmbCpr.Text) <> "" Then
        LConRs.Open "select Dm_领料表.ID,Dm_领料表.图号,品名,规格,部门名称,站机人,擦片人,领一级,仓库名称1,领二级,仓库名称2,领料日期,Dm_领料表.创建者 from Dm_领料表 inner join Bs_产品图号 on Dm_领料表.图号=Bs_产品图号.图号 where 擦片人= '" _
                & CmbCpr.Text & "' and  部门名称 = '" & CmbBmmc.Text & "' 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
    Else
        LConRs.Open "select Dm_领料表.ID,Dm_领料表.图号,品名,规格,部门名称,站机人,擦片人,领一级,仓库名称1,领二级,仓库名称2,领料日期,Dm_领料表.创建者 from Dm_领料表 inner join Bs_产品图号 on Dm_领料表.图号=Bs_产品图号.图号 where 站机人= '" _
                & CmbZjr.Text & "' and  擦片人 = '" & CmbCpr.Text & "' and  部门名称 = '" & CmbBmmc.Text & "' 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.