form1.frm

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

        End If
    rs.Close

remClear:
    Set rs = Nothing
    Exit Sub
errLabel:
    objDatabase.DatabaseError
    GoTo remClear
End Sub
Private Sub CmdFabric_Click()
    frmFabricSelect.Show vbModal
    GetFabricInfo frmFabricSelect.FabricCode
End Sub

Private Sub CmdView_Click()
        FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "'")
End Sub

Private Sub ColorAdd_Click()
    frmBeforeColor.newItem = True
    frmBeforeColor.InitInfo "", txtLabdipNo, txtOrderNo
    frmBeforeColor.Show vbModal
End Sub

Private Sub ColorDel_Click()
    Dim strSql As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    On Error GoTo errHandle
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from  tBeforeLabdipColor  where id=" & MSHF2.TextMatrix(lngrow, 7)
        objDatabase.ExecCmd strSql
        strSql = "delete from  tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "' and ColorName='" & MSHF2.TextMatrix(lngrow, 1) & "'"
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
       rs.Open "select Color from tBeforeLabdipColor where Color=0 and LabdipNo='" & txtLabdipNo & "'", Cn, 1, 3
        If rs.BOF Or rs.EOF Then
           chkColor.Value = 1
        Else
           chkColor.Value = 0
        End If
        rs.Close
        Set rs = Nothing
        frmBeforeInfo.FillMshf2 ("select * from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'")
        frmBeforeInfo.FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "'")
    Exit Sub
errHandle:
   objDatabase.DatabaseError
End Sub

Private Sub ColorEdit_Click()
    If MSHF2.TextMatrix(lngrow, 7) <> "" Then
        frmBeforeColor.newItem = False
        frmBeforeColor.InitInfo MSHF2.TextMatrix(lngrow, 7), txtLabdipNo, txtOrderNo
        frmBeforeColor.Show vbModal
    End If
End Sub

Private Sub ComFabricCode_Change()
FillMshf1 ("select * from tBasicFabric where FabricCode='" & ComFabricCode.Text & "'")
SSTab1.Tab = 0
End Sub
Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    Initcbb ComFactoryName, "FactoryName", "tBasicFactory"
    FillMshf1 ("select * from tBasicFabric where FabricCode='" & ComFabricCode.Text & "'")
    FillMshf2 ("select * from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'")
    FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "'")
    FillMshf5 ("select * from tBeforeLabdipReference where LabdipNo='" & txtLabdipNo & "'")
    FillMshf6 ("select * from tBeforeLabdipLayoutSub where LabdipNo='" & txtLabdipNo & "'")
    ActiveBar21.Bands("toolbar").Tools.item("DataView").CBAddItem ("顏色")
    ActiveBar21.Bands("toolbar").Tools.item("DataView").CBAddItem ("顏色明細")
    ActiveBar21.Bands("toolbar").Tools.item("DataView").CBAddItem ("花型")
    ActiveBar21.Bands("toolbar").Tools.item("DataView").CBAddItem ("用途")
    ActiveBar21.Bands("toolbar").Tools.item("DataView").CBAddItem ("質量")
    ColorDel.Enabled = False
    ColorEdit.Enabled = False
    subDel.Enabled = False
    SubEdit.Enabled = False
    LayoutDel.Enabled = False
    LayoutEdit.Enabled = False
    ReferenceEdit.Enabled = False
    ReferenceDel.Enabled = False
    InitTitle
    InitColorLayout ColorLayout, "tBasicColorLayout"
    HookWheel Me.hwnd
End Sub
Private Sub InitTitle()
    Label1.Caption = "上批單號"
    Label2.item(0).Caption = "訂單號"
    Label2.item(1).Caption = "客戶編號"
    Label2.item(2).Caption = "客戶簡稱"
    Label2.item(3).Caption = "廠名"
    Label2.item(6).Caption = "季節"
    Label2.item(5).Caption = "交貨期"
    Label2.item(7).Caption = "交期日期"
    Label2.item(9).Caption = "布號"
  '  Label2.item(8).Caption = "花號/顏色"
    Label2.item(10).Caption = "花型/顏色"
    Label2.item(12).Caption = "款號"
    Label2.item(11).Caption = "顏料"
    Label2.item(13).Caption = "整理"
    Label2.item(15).Caption = "品種"
    Label4.Caption = "花型/顏色標準"
    Label2.item(16).Caption = "價格"
    chkQuality.Caption = "質量"
    Label7.Caption = "後加日期"
    Label3.Caption = "取消日期"
    chkColor.Caption = "顏色"
    Label2.item(17).Caption = "備註"
    chkType.Caption = "花型"
    Label10.Caption = "創建人"
    Label12.Caption = "更新日期"
    Me.Caption = "預備工序資料"
End Sub
Private Sub Save(Optional blModi As Boolean)
   Dim rs As ADODB.Recordset
    Dim strSql As String
   ' On Error GoTo errHandle
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = Cn
    End With
    If txtLabdipNo.Text = "" Then
        MsgBox "上批單號不能為空！", vbCritical, "提示"
        txtLabdipNo.SetFocus
        Exit Sub
    End If
    If txtOrderNo.Text = "" Then
        MsgBox "訂單號不能為空！", vbCritical, "提示"
        txtOrderNo.SetFocus
        Exit Sub
    End If
    If txtOrderNo = "" Then
        MsgBox "布號信息不能為空", vbInformation + vbOKOnly, "提示"
        txtOrderNo.SetFocus
        Exit Sub
    End If
    If txtReference.Text = "" Then
        MsgBox "款號不能為空！", vbCritical, "提示"
        txtReference.SetFocus
        Exit Sub
    End If
    rs.Open "select * from tBeforeLabdipReference where Reference='" & txtReference & "'"
    If rs.EOF Or rs.BOF Then
        MsgBox "請將用途子欄數據填寫一下"
        txtReference.SetFocus
        Exit Sub
    End If
    rs.Close
    If blModi Then
        strSql = "select * from tBeforeLabdip where LabdipNo='" & Trim$(txtLabdipNo.Text) & "'"
        rs.Open strSql
        If Not rs.EOF Then
            MsgBox "此上批單號已存在！", vbCritical, "提示"
            txtLabdipNo.Text = ""
            txtLabdipNo.SetFocus
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
        If MsgBox("是否添加新的上批單？", vbQuestion + vbYesNo, "询问") = vbNo Then
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
                
        rs.AddNew '新建
    Else
        strSql = "select * from tBeforeLabdip where LabdipNo='" & txtLabdipNo & "'"
        rs.Open strSql
        If rs.EOF Then '修改
            MsgBox "没有可修改的信息!", vbExclamation, "修改"
            rs.Close
            Set rs = Nothing
            txtClientNo.SetFocus
            Exit Sub
        End If
        If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
            rs.Close
            Set rs = Nothing
            Exit Sub
        End If
    End If
        rs.Fields!LabdipNo = Trim$(txtLabdipNo)
        rs.Fields!OrderNo = Trim$(txtOrderNo)
        rs.Fields!ClientNo = Trim$(txtClientNo)
        rs.Fields!ClientName = Trim$(txtClientName)
        rs.Fields!Season = Trim$(txtSeason)
        rs.Fields!SeasonLine = Trim$(txtSeasonLine)
        rs.Fields!Delivery = DTPdelivery.Value
        rs.Fields!FabricCode = Trim$(ComFabricCode)
        rs.Fields!Pattern = Trim$(ColorLayout.Text)
       ' rs.Fields!ePattern = Trim$(txtePattern)
        rs.Fields!Reference = Trim$(txtReference)
        rs.Fields!Dye = Trim$(txtDye)
        rs.Fields!Finish = Trim$(txtFinish)
        rs.Fields!Processing = Trim$(txtProcessing)
        rs.Fields!Quality = chkQuality.Value
        rs.Fields!Color = chkColor.Value
        rs.Fields!Layout = chkType.Value
        rs.Fields!FactoryName = Trim$(ComFactoryName)
        rs.Fields!Standard = Trim$(txtStandard)
        rs.Fields!LateAddDate = DTPlate.Value
        rs.Fields!DropDate = DTPdrop.Value
        rs.Fields!Price = IIf(IsNumeric(txtPrice), txtPrice, "0")
        rs.Fields!Remarks = Trim$(txtRemarks)
        rs.Fields!UpdateOperator = Trim$(txtUpdateOperator)
        rs.Fields!UpdateDate = Now
        rs.Update
        rs.Close
        rs.Open "select * from tBeforeLabdipQuality"
        rs.AddNew
        rs.Fields!LabdipNo = Trim$(txtLabdipNo)
        rs.Fields!OrderNo = Trim$(txtOrderNo)
        rs.Fields!FabricName = Trim$(MSHF1.TextMatrix(2, 1))
        rs.Fields!eFabricName = Trim$(MSHF1.TextMatrix(2, 2))
        rs.Fields!Composition = Trim$(MSHF1.TextMatrix(2, 3))
        rs.Fields!FabricType = Trim$(MSHF1.TextMatrix(2, 4))
        rs.Fields!Wales = Trim$(MSHF1.TextMatrix(2, 5))
        rs.Fields!Harness = Trim$(MSHF1.TextMatrix(2, 6))
        rs.Fields!Construstion = Trim$(MSHF1.TextMatrix(2, 7))
        rs.Fields!Greige = Trim$(MSHF1.TextMatrix(2, 8))
        rs.Fields!Weight = Trim$(MSHF1.TextMatrix(2, 9))
        rs.Fields!Width = MSHF1.TextMatrix(2, 10)
        rs.Fields!Finish = MSHF1.TextMatrix(2, 11)
        rs.Fields!Price = MSHF1.TextMatrix(2, 12)
        rs.Fields!Remarks = MSHF1.TextMatrix(2, 13)
        rs.Fields!UpdateOperator = MSHF1.TextMatrix(2, 14)
        rs.Fields!UpdateDate = MSHF1.TextMatrix(2, 15)
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
    rs.Close
    Set rs = Nothing

    frmBeforeMain.FillMshf1 ("select * from tBeforeLabdip,tBeforeLabdipReference where tBeforeLabdip.Reference=tBeforeLabdipReference.Reference")
    Unload Me
    Exit Sub
    
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub

Private Sub LayoutAdd_Click()
    If txtLabdipNo = "" Then
       MsgBox "請先填寫上批單號，訂單號等基本信息", vbInformation + vbOKOnly, "提示"
       txtLabdipNo.SetFocus
       Exit Sub
    End If
    frmBeforeLayout.newItem = True
    frmBeforeLayout.InitInfo "", txtLabdipNo, txtOrderNo
    frmBeforeLayout.Show vbModal
End Sub

Private Sub LayoutDel_Click()
    Dim strSql As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    On Error GoTo errHandle
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from  tBeforeLabdipLayoutSub  where id=" & MSHF6.TextMatrix(lngrow, 9)
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        rs.Open "select Layout from tBeforeLabdipLayoutSub where Layout=0 and LabdipNo='" & txtLabdipNo & "'", Cn, 1, 3
        If rs.BOF Or rs.EOF Then
           chkType.Value = 1
        Else
           chkType.Value = 0
        End If
        rs.Close
        Set rs = Nothing
        frmBeforeInfo.FillMshf6 ("select * from tBeforeLabdipLayoutSub where LabdipNo='" & txtLabdipNo & "'")
    Exit Sub
errHandle:
   objDatabase.DatabaseError
End Sub

Private Sub LayoutEdit_Click()
    If MSHF6.TextMatrix(lngrow, 9) <> "" Then
        frmBeforeLayout.newItem = False
        frmBeforeLayout.InitInfo MSHF6.TextMatrix(lngrow, 9), txtLabdipNo, txtOrderNo
    End If
    frmBeforeLayout.Show vbModal
End Sub

Private Sub MSHF1_Click()
        lngrow = Val(MSHF1.row)
        If lngrow = 1 Then
             MSHF1.Sort = 1
        Else
            txtModi.Top = MSHF1.CellTop + 390
            txtModi.Left = MSHF1.CellLeft + 110
            txtModi.Height = MSHF1.CellHeight
            txtModi.Width = MSHF1.CellWidth
            txtModi.Visible = True
            txtModi.Text = MSHF1.TextMatrix(MSHF1.row, MSHF1.col)
            txtModi.SetFocus
            txtModi.SelStart = 0
            txtModi.SelLength = Len(txtModi.Text)
        End If
End Sub

Private Sub MSHF2_DblClick()
    lngrow = Val(MSHF2.row)
    If MSHF2.TextMatrix(lngrow, 7) <> "" Then
        frmBeforeColor.newItem = False
        frmBeforeColor.InitInfo MSHF2.TextMatrix(lngrow, 7), txtLabdipNo, txtOrderNo
    Else
    If txtLabdipNo = "" Then
       MsgBox "請先填寫上批單號，訂單號等基本信息", vbInformation + vbOKOnly, "提示"
       txtLabdipNo.SetFocus
       Exit Sub
    End If
        frmBeforeColor.newItem = True
        frmBeforeColor.InitInfo MSHF2.TextMatrix(lngrow, 7), txtLabdipNo, txtOrderNo
    End If
    frmBeforeColor.Show vbModal
End Sub

Private Sub MSHF2_Click()
    lngrow = Val(MSHF2.row)
    If lngrow = 1 Then
        FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "'")
        ColorEdit.Enabled = False
        ColorDel.Enabled = False
        Exit Sub
    Else
        ColorEdit.Enabled = True
        ColorDel.Enabled = True
        FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "' and ColorName='" & MSHF2.TextMatrix(lngrow, 1) & "'")
    End If
End Sub
Private Sub MSHF3_DblClick()
    lngrow = Val(MSHF3.row)
    If MSHF3.TextMatrix(lngrow, 9) <> "" Then
        frmBeforeColorSub.newItem = False
        frmBeforeColorSub.InitInfo MSHF3.TextMatrix(lngrow, 9),