frmproductionembryooutedit.frm

企业ERP系统 采用VB+SQL2000实现。 有客户合约

            Left            =   3900
            TabIndex        =   11
            Top             =   1080
            Width           =   855
         End
      End
   End
End
Attribute VB_Name = "frmProductionEmbryoOutEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加
Dim oldAmount As Integer
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
            Case "cmdSave":
                 Save newItem
           Case "cmdCancel":
                Unload Me
            Case "cmdDel":
                DelOperatorInf
    End Select
End Sub
Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    If newItem Then
        ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    End If
    Initcbb txtGreige, "Greige", "tBasicProduct where FabricCode='" & txtFabricCode & "'"
    Initcbb txtwidth, "Width", "tBasicProduct where FabricCode='" & txtFabricCode & "'"
    Initcbb txtOrderNo, "OrderNo", "tBusinessOrderSub"
    InitTitle
End Sub
Private Sub InitTitle()
    Label50.Caption = "合同編號"
    Label7.Caption = "供應商"
    Label22.Caption = "布名"
    Label40.Caption = "布號"
    Label13.Caption = "加工單號"
    Label1.Caption = "加工廠"
    Label15.Caption = "出胚數量"
    Label3.item(4).Caption = "幅寬"
    Label10.Caption = "投胚日期"
    Label3.item(3).Caption = "胚組織"
    Label23.Caption = "查驗情況"
    Me.Caption = "坯布出坯"
End Sub
Private Sub DelOperatorInf()
    Dim strSql As String
    Dim mycomm As New ADODB.Command
    On Error GoTo errHandle
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from tProductionEmbryoOut where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
    Set mycomm = New ADODB.Command
     With mycomm
        .ActiveConnection = Cn
        .CommandText = "pModiEmbryoOut"
        .CommandType = 4
        .Prepared = True
        .Parameters.Append .CreateParameter("@iEmbryoContractNo", adVarChar, adParamInput, 20, txtEmbryoContractNo)
        .Parameters.Append .CreateParameter("@iModiAmount", 129, adParamInput, 100, CInt(txtAmount))
        .Execute
     End With
        frmProductionEmbryoOut.FillMshf1 ("select * from tProductionEmbryoOut where EmbryoContractNo='" & txtEmbryoContractNo & "'")
        frmProductionEmbryoContractMain.FillMshf1 ("select * from tProductionEmbryoContract")
    Unload Me
    Exit Sub
errHandle:
   objDatabase.DatabaseError
    
End Sub
Public Sub InitInfo(strId As String)
    If newItem = False Then
    Dim rs As ADODB.Recordset
      SystemExecuteStart Me
     ' On Error GoTo errLabel
      Set rs = New ADODB.Recordset
      With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        Set .ActiveConnection = Cn
      End With
      Dim strSql As String
        strSql = "select * from tProductionEmbryoOut where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            DtpFoundDate.Value = NullValue(rs.Fields!Founddate)
            txtGreige = NullValue(rs.Fields!Greige)
            txtwidth = NullValue(rs.Fields!Width)
            txtRemark = NullValue(rs.Fields!Remark)
            txtAmount = NullValue(rs.Fields!Amount)
            txtOrderNo = NullValue(rs.Fields!OrderNo)
            txtId = NullValue(rs.Fields!ID)
            oldAmount = NullValue(rs.Fields!Amount)
        End If
      rs.Close
      Set rs = Nothing
      SystemExecuteEnd Me
    Exit Sub
    End If
errLabel:
        SystemExecuteEnd Me
        objDatabase.DatabaseError
End Sub
Private Sub Save(Optional blModi As Boolean)
    Dim strSql As String
    Dim rs As ADODB.Recordset
    Dim modiValue As String
    Dim mycomm As ADODB.Command
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    If txtOrderNo = "" Then
       MsgBox "請將加工單號填寫完整 ", vbInformation + vbOKOnly, " 提示"
       txtOrderNo.SetFocus
       Exit Sub
    End If
    If IsNumeric(txtAmount) = False Then
       MsgBox "請正確填寫進坯數量 ", vbInformation + vbOKOnly, " 提示"
       txtAmount.SetFocus
       Exit Sub
    End If
        On Error GoTo errHandle
        If blModi Then
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                Exit Sub
            End If
            strSql = "select LeftAmount from tproductionEmbryoContract where EmbryoContractNo='" & txtEmbryoContractNo & "'"
            rs.Open strSql
            oldAmount = rs.Fields!leftAmount - CInt(txtAmount)
            If oldAmount <= 1 Then
                 If MsgBox("庫存不足，還要出坯嗎？", vbQuestion + vbYesNo, "詢問") = vbNo Then
                    rs.Close
                    Set rs = Nothing
                    Exit Sub
                End If
            End If
            If rs.State = 1 Then rs.Close
            oldAmount = CInt(txtAmount)
            strSql = "select * from tProductionEmbryoOut"
            rs.Open strSql
            rs.AddNew '新建
        Else
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
            strSql = "select LeftAmount from tproductionEmbryoContract where EmbryoContractNo='" & txtEmbryoContractNo & "'"
            rs.Open strSql
            oldAmount = CInt(txtAmount) - oldAmount
            If oldAmount > 0 Then
                If rs.Fields!leftAmount <= Abs(oldAmount) Then
                    If MsgBox("您的修改將導制庫存不足，真要要修改嗎？", vbQuestion + vbYesNo, "警告") = vbNo Then
                        rs.Close
                        Set rs = Nothing
                    Exit Sub
                    End If
                End If
            End If
            rs.Close
            strSql = "select * from tProductionEmbryoOut where id=" & txtId
            rs.Open strSql
        End If
        rs.Fields!EmbryoContractNo = Trim$(txtEmbryoContractNo)
        rs.Fields!Founddate = DtpFoundDate.Value
        rs.Fields!SuppliersName = Trim$(txtSuppliersName)
        rs.Fields!FabricCode = Trim$(txtFabricCode)
        rs.Fields!FabricName = Trim$(txtFabricName)
        rs.Fields!Greige = Trim$(txtGreige)
        rs.Fields!Width = Trim$(txtwidth)
        rs.Fields!Remark = Trim$(txtRemark)
        rs.Fields!Amount = Trim$(txtAmount)
        rs.Fields!FactoryName = Trim$(txtFactoryName)
        rs.Fields!OrderNo = Trim$(txtOrderNo)
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        Set mycomm = New ADODB.Command
         With mycomm
            .ActiveConnection = Cn
            .CommandText = "pModiEmbryoOut"
            .CommandType = 4
            .Prepared = True
            .Parameters.Append .CreateParameter("@iEmbryoContractNo", adVarChar, adParamInput, 20, txtEmbryoContractNo)
            .Parameters.Append .CreateParameter("@iModiAmount", adBigInt, adParamInput, 8, oldAmount)
            .Execute
         End With
         rs.Open "select ConsumeAmount,leftAmount from tProductionEmbryoContract where EmbryoContractNo='" & txtEmbryoContractNo & "'", Cn, 1, 3
         Dim rsobj As ADODB.Recordset
         Set rsobj = New ADODB.Recordset
         rsobj.Open "select EmbryoAmount,stockamount from tBusinessOrderSub where OrderNo='" & txtOrderNo & "'", Cn, 1, 3
         If Not rsobj.EOF Then
         rsobj.Fields!EmbryoAmount = rs.Fields!ConsumeAmount
         rsobj.Fields!StockAmount = rs.Fields!leftAmount
         rsobj.Update
         End If
         rs.Close
         rsobj.Close
         Set rsobj = Nothing
        Set rs = Nothing
        frmProductionEmbryoOut.FillMshf1 ("select * from tProductionEmbryoOut where EmbryoContractNo='" & txtEmbryoContractNo & "'")
        frmProductionEmbryoContractMain.FillMshf1 ("select * from tProductionEmbryoContract")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub