frmproductionprogressinfo.frm

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

           Case "cmdCancel":
                Unload Me
            Case "cmdDel":
                DelOperatorInf
            Case "cmdPrint"
'                Call PrintEmbryoContract
    End Select
End Sub
Private Sub PrintEmbryoContract()
'   Dim rs As ADODB.Recordset
'   Set rs = New ADODB.Recordset
'   Dim strSql As String
'    With rs
'      .CursorLocation = adUseClient
'      .CursorType = adOpenDynamic
'      .LockType = adLockOptimistic
'      Set .ActiveConnection = cn
'    End With
'    strSql = "select * from tProductionEmbryoContract as a,tBasicFabric as b "
'    strSql = strSql & "where EmbryoContractNo='" & txtEmbryoContractNo & "'and a.FabricCode='" & ComFabricCode & "' and b.FabricCode='" & ComFabricCode & "'"
'    rs.Open strSql
'   With BillEmbryoContract
'       .EmbryoContractNo.SetText (rs.Fields!EmbryoContractNo)
'       .FoundDate.SetText (rs.Fields!FoundDate)
'       .SuppliersName.SetText (rs.Fields!SuppliersName)
'       .Linkman.SetText (rs.Fields!Linkman)
'       .Operation.SetText (rs.Fields!Operation)
'       .FabricName.SetText (rs.Fields!FabricName)
'       .Composition.SetText (rs.Fields!Composition)
'       .fWidth.SetText (txtWidth)
'       .FabricCode.SetText (rs.Fields!FabricCode)
'       .Price.SetText (rs.Fields!Price)
'       .Delivery.SetText (rs.Fields!Delivery)
'       .Remark.SetText (rs.Fields!Remark)
'       .Amount.SetText (rs.Fields!Amount)
'   End With
'    rs.Close
'    Set rs = Nothing
'    frmReportEmbryoContract.Show vbModal
End Sub

Private Sub CmdFabric_Click()
    frmFabricSelect.Show vbModal
    GetFabricInfo frmFabricSelect.FabricCode
End Sub
Private Sub GetFabricInfo(FabricNo As String)
        Dim rs As ADODB.Recordset
    On Error GoTo errLabel
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    rs.Open "select * from tBasicProduct where FabricCode=" & objDatabase.FormatSQL(FabricNo)
        If Not rs.EOF Then
            txtComposition = NullValue(rs.Fields!Composition)
            ComFabricName = NullValue(rs.Fields!FabricName)
            ComFabricNo = NullValue(rs.Fields!FabricCode)
            txtwidth = NullValue(rs.Fields!Width)
        End If
    rs.Close

remClear:
    Set rs = Nothing
    Exit Sub
errLabel:
    objDatabase.DatabaseError
    GoTo remClear
End Sub

Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    Initcbb ComFactoryName, "FactoryName", "tBasicFactory"
    Initcbb ComUnit, "UnitName", "tBasicUnit"
    Initcbb comEmbryoUnit, "UnitName", "tBasicUnit"
    Initcbb ComCurrencyUnit, "UnitName", "tBasicUnit"
    Initcbb comSuppliersName, "SuppliersName", "tBasicFabricSuppliers"
    InitColorLayout ColorLayout, "tBasicColorLayout"
    Initcbb txtCurrencyName, "CurrencyName", "tBasicCurrency"
    InitTitle
End Sub
Private Sub InitTitle()
    Label1.Caption = "加工單編號"
    Label2.item(0).Caption = "供應商"
    Label2.item(1).Caption = "成品布號"
    Label2.item(2).Caption = "布名"
    Label2.item(6).Caption = "胚組織"
    Label7.Caption = "顏色花型"
    Label2.item(5).Caption = "幅寬"
    'Label8.Caption = "英文顏色花型"
    Label2.item(13).Caption = "單位"
    Label10.Caption = "上批最後日期"
    Label2.item(7).Caption = "上批結果"
    Label11.Caption = "投坯日期"
    Label2.item(11).Caption = "投坯數量"
    Label2.item(10).Caption = "生產狀態"
    Label2.item(4).Caption = "單位"
    Label9.Caption = "UlkColor"
    Label2.item(14).Caption = "查貨日期"
    Label4.Caption = "幣種"
    Label3.Caption = "測試結果"
    Label6.Caption = "單價"
    Label5.Caption = "對應匯率"
    Label12.Caption = "出貨數量"
    Label2.item(18).Caption = "貨幣單位"
    Label22.Caption = "成品數量"
    Label13.Caption = "季節"
    Label21.Caption = "碼單"
    Label2.item(15).Caption = "查貨報告"
    Label25.Caption = "投批備註"
    Label24.Caption = "加工廠"
    Label23.Caption = "客戶款號"
    Label14.Caption = "煮漂"
    Label15.Caption = "絲光"
    Label16.Caption = "磨毛"
    Label17.Caption = "染色"
    Label18.Caption = "印花"
    Label19.Caption = "整理"
    Label20.Caption = "批色辦"
    Me.Caption = "生產進度明細"
End Sub
Private Sub DelOperatorInf()
    Dim strSql As String
    On Error GoTo errHandle
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from  tBusinessOrderSub where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        frmProductionProgress.FillMshf1 ("select * from tBusinessOrderSub a ,(select distinct orderno,delivery from tBusinessOrder) b where a.orderno=b.orderno order by a.orderno")
    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 tBusinessOrderSub where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            txtOrderNo.Text = NullValue(rs.Fields!OrderNo)
            txtOrderNo.Enabled = False
            ComFabricNo = NullValue(rs.Fields!FabricNo)
            ComFabricName = NullValue(rs.Fields!FabricName)
            txtComposition = NullValue(rs.Fields!Composition)
            txtwidth = NullValue(rs.Fields!Width)
            ColorLayout.Text = NullValue(rs.Fields!LayoutColor)
           ' txteLayoutColor = NullValue(rs.Fields!elayoutcolor)
            ComUnit = NullValue(rs.Fields!unit)
            chkLabdip.Value = IIf(rs.Fields!Labdip, "1", "0")
            LateDate.Value = NullValue(rs.Fields!LateDate)
            comSuppliersName = NullValue(rs.Fields!SuppliersName)
            txtEmbryoAmount = NullValue(rs.Fields!EmbryoAmount)
            EmbryoDate = NullValue(rs.Fields!EmbryoDate)
            comEmbryoUnit = NullValue(rs.Fields!EmbryoUnit)
            txtEmbryoRemark = NullValue(rs.Fields!EmbryoRemark)
            txtProductionState = NullValue(rs.Fields!ProductionState)
            txtUlkColor = NullValue(rs.Fields!UlkColor)
            txtUlkQuality = NullValue(rs.Fields!UlkQuality)
            txtReport = NullValue(rs.Fields!Report)
            ReportDate = NullValue(rs.Fields!ReportDate)
            chkMtlResult = IIf(IsNull(rs.Fields!MtlResult), "0", "1")
            txtCurrencyName = NullValue(rs.Fields!CurrencyName)
            txtRate = NullValue(rs.Fields!Rate)
            txtPrice = NullValue(rs.Fields!Price)
            ComCurrencyUnit = NullValue(rs.Fields!CurrencyUnit)
            txtShipmentsAmount = NullValue(rs.Fields!ShipmentsAmount)
            txtSeason = NullValue(rs.Fields!Season)
            ItemDate1 = NullValue(rs.Fields!ItemDate1)
            ItemDate2 = NullValue(rs.Fields!ItemDate2)
            ItemDate3 = NullValue(rs.Fields!ItemDate3)
            ItemDate4 = NullValue(rs.Fields!ItemDate4)
            ItemDate5 = NullValue(rs.Fields!ItemDate5)
            ItemDate6 = NullValue(rs.Fields!ItemDate6)
            ItemDate7 = NullValue(rs.Fields!ItemDate7)
            txtProductionQuantity = NullValue(rs.Fields!ProductionQuantity)
            txtCodeAmount = NullValue(rs.Fields!CodeAmount)
            txtProductionQuantity = NullValue(rs.Fields!ProductionQuantity)
            txtCustomerReference = NullValue(rs.Fields!CustomerReference)
            ComFactoryName = NullValue(rs.Fields!FactoryName)
            txtId = NullValue(rs.Fields!ID)
        End If
        rs.Close
      Set rs = Nothing
      SystemExecuteEnd Me
Exit Sub
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
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
        On Error GoTo errHandle
        If IsNumeric(txtPrice) = False Then
            MsgBox "請在胚價上填寫正確格式", vbCritical, "提示"
            txtPrice.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtEmbryoAmount) = False Then
            MsgBox "請在投胚數量上填寫正確格式", vbCritical, "提示"
            txtEmbryoAmount.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtRate) = False Then
            MsgBox "請在匯率上填寫正確格式", vbCritical, "提示"
            txtRate.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtShipmentsAmount) = False Then
            MsgBox "請在出貨數量上填寫正確格式", vbCritical, "提示"
            txtShipmentsAmount.SetFocus
            Exit Sub
        End If
        If IsNumeric(txtProductionQuantity) = False Then
            MsgBox "請在出貨數量上填寫正確格式", vbCritical, "提示"
            txtProductionQuantity.SetFocus
            Exit Sub
        End If
        If blModi Then
        strSql = "select * from tBusinessOrderSub"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
                    
            rs.AddNew '新建
        Else
            strSql = "select * from tBusinessOrderSub where id=" & txtId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtOrderNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!OrderNo = txtOrderNo
        rs.Fields!FabricNo = ComFabricNo
        rs.Fields!FabricName = ComFabricName
        rs.Fields!Composition = txtComposition
        rs.Fields!Width = txtwidth
        rs.Fields!LayoutColor = ColorLayout.Text
       ' rs.Fields!elayoutcolor = txteLayoutColor
        rs.Fields!unit = ComUnit
        rs.Fields!Labdip = chkLabdip.Value
        rs.Fields!LateDate = LateDate.Value
        rs.Fields!SuppliersName = comSuppliersName
        rs.Fields!EmbryoAmount = txtEmbryoAmount
        rs.Fields!EmbryoDate = EmbryoDate
        rs.Fields!EmbryoUnit = comEmbryoUnit
        rs.Fields!EmbryoRemark = txtEmbryoRemark
        rs.Fields!ProductionState = txtProductionState
        rs.Fields!UlkColor = txtUlkColor
        rs.Fields!UlkQuality = txtUlkQuality
        rs.Fields!UlkLayout = txtUlkLayout
        rs.Fields!Report = txtReport
        rs.Fields!ReportDate = ReportDate.Value
        rs.Fields!MtlResult = chkMtlResult
        rs.Fields!CurrencyName = txtCurrencyName
        rs.Fields!Rate = txtRate
        rs.Fields!Price = txtPrice
        rs.Fields!CurrencyUnit = ComCurrencyUnit
        rs.Fields!ShipmentsAmount = txtShipmentsAmount
        rs.Fields!Season = txtSeason
        rs.Fields!ItemDate1 = ItemDate1.Value
        rs.Fields!ItemDate2 = ItemDate2.Value
        rs.Fields!ItemDate3 = ItemDate3.Value
        rs.Fields!ItemDate4 = ItemDate4.Value
        rs.Fields!ItemDate5 = ItemDate5.Value
        rs.Fields!ItemDate6 = ItemDate6.Value
        rs.Fields!ItemDate7 = ItemDate7.Value
        rs.Fields!CodeAmount = txtCodeAmount
        rs.Fields!ProductionQuantity = txtProductionQuantity
        rs.Fields!CustomerReference = txtCustomerReference
        rs.Fields!FactoryName = ComFactoryName
        rs.Fields!StockAmount = CInt(txtProductionQuantity) - CInt(txtShipmentsAmount)
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
         Set rs = Nothing
        frmProductionProgress.FillMshf1 ("select * from tBusinessOrderSub a ,(select distinct orderno,delivery from tBusinessOrder) b where a.orderno=b.orderno order by a.orderno")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub


Private Sub txtCodeAmount_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub txtEmbryoAmount_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub txtPrice_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub
Private Sub txtProductionQuantity_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub txtRate_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub txtShipmentsAmount_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub