frmcpwh.frm

适合于中小型企业管理

          Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
          Set ExecuteSQL = Mrc
          
            If Mrc!Cy > 0 Then
                LrText(1).SetFocus
                MsgBox "重复品名！"
                Exit Sub
            End If
            Mrc.Close
    End If
        SqlTxt = "Update Bs_产品图号 Set 图号='" & Trim(LrText(0).Text) & "',品名='" & Trim(LrText(1).Text) & "',规格='" & Trim(LrText(2).Text) & "',硝材='" & Trim(LrText(3).Text) _
        & "',创建者='" & Xtczy & "',创建日期='" & Trim(LrText(5).Text) & "' WHERE (ID=" & Trim(lstContracts.SelectedItem.Text) & ")"
        CmdExe.CommandText = SqlTxt
        CmdExe.Execute
        MsgBox "记录修改成功！", vbInformation
End If
    Call Toolfbjzt
    Call Cxnrtcwg
End Sub

Private Sub Form_Load()
    '调入网格设置信息
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , " ID", 800
    lstContracts.ColumnHeaders.Add , , "  图号", 1200
    lstContracts.ColumnHeaders.Add , , "    品名", 1480
    lstContracts.ColumnHeaders.Add , , "    规格", 1480
    lstContracts.ColumnHeaders.Add , , "    硝材", 1480
    lstContracts.ColumnHeaders.Add , , "  创建者", 1280
    lstContracts.ColumnHeaders.Add , , "  创建日期", 1480

    
    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
    LrText(4).Text = Xtczy
    '设置为非录入状态
    Lrzt = 0
    Set CmdExe = New ADODB.Command
    CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
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(5).Text = Gsdate()
            Cxnrrec.AddNew
        Case "xg"                                            '修 改
            Call Xgdqjl
            LrText(5).Text = Gsdate()
            AddFlg = False
        Case "sc"                                            '删 除
            DelFlg = False
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        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(1).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(1).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(1).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(1).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 仓库结存 FROM Bs_期初数据 where 图号='" & Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If RsCsDel.BOF And RsCsDel.EOF Then

        Else
        If RsCsDel!仓库结存 > 0 Then
                MsgBox "此品种仓库期初结存数量为：" & RsCsDel!仓库结存 & "！（" & Trim(lstContracts.SelectedItem.ListSubItems.Item(1).Text) & "）", vbCritical, "特别提醒："
                DelFlg = True
        End If
        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 Cxnrtcwg
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!创建者
             LrText(5).Text = Cxnrrec!创建日期
    End If
    AddFlg = False
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

     
End Function

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


    '[>>查询连接串
    Set Cxnrrec = New ADODB.Recordset
    Cxnrrec.Open "SELECT * FROM Bs_产品图号 order by 图号", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
       
    With Cxnrrec

        If .EOF And .BOF Then

            Exit Sub
        End If

        
        '[>>以下为自定义部分
        Dim ItmX As ListItem
    
        lstContracts.ListItems.Clear
        Do While Not .EOF
            Set ItmX = lstContracts.ListItems.Add(, , Cxnrrec!Id)
             ItmX.SubItems(1) = Cxnrrec!图号
             ItmX.SubItems(2) = Cxnrrec!品名
             ItmX.SubItems(3) = Cxnrrec!规格
             ItmX.SubItems(4) = Cxnrrec!硝材
             ItmX.SubItems(5) = Cxnrrec!创建者
             ItmX.SubItems(6) = Cxnrrec!创建日期
            
            Cxnrrec.MoveNext
        Loop
    End With
  
    '将网格刷新动作解冻
     lstContracts.Refresh
    
End Sub

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

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    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
    Frame1.Enabled = False
    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 Ydcommand1_Click(Index As Integer)
    Frm选择产品图号.Show 1
End Sub