frmbeforeadd.frm

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

            Reference.Text = rs.Fields!Reference
            Placement = rs.Fields!Placement
            Washing = rs.Fields!Washing
            RefUpdateOperator = rs.Fields!UpdateOperator
            RefUpdateDate = rs.Fields!UpdateDate
            refId = rs.Fields!ID
        End If
        rs.Close
     End If
      Set rs = Nothing
      SystemExecuteEnd Me
Exit Sub
Else
    If viewFlag = "Color" Then
            txtLabdipNo.Text = LabdipNo
            txtOrderNo.Text = OrderNo
    End If
    If viewFlag = "subColor" Then
            subLabdipNo.Text = LabdipNo
            subOrderNo.Text = OrderNo
    End If
    If viewFlag = "Layout" Then
            LayoutLabdipNo.Text = LabdipNo
            LayoutOrderNo.Text = OrderNo
    End If
    If viewFlag = "subLayout" Then
            subLayoutLabdipNo.Text = LabdipNo
            subLayoutOrderNo.Text = OrderNo
    End If
    If viewFlag = "Placement" Then
            RefLabdipNo.Text = LabdipNo
            RefOrderNo.Text = OrderNo
    End If
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 strCdh, strZl, strSl As String
    Dim rs As ADODB.Recordset
    Dim mycomm As ADODB.Command
    Set rs = New ADODB.Recordset
    With rs
      .CursorLocation = adUseClient
      .CursorType = adOpenDynamic
      .LockType = adLockOptimistic
      Set .ActiveConnection = cn
    End With
    If viewFlag = "Color" Then
        strSql = "select * from tBeforeLabdipColor where ColorName='" & Trim$(txtColorName) & "'"
        On Error GoTo errHandle
        rs.Open strSql
        If IsNumeric(txtColorNumber) = False Then
            MsgBox "請在次數上填寫數字", vbCritical, "提示"
            rs.Close
            Set rs = Nothing
            txtColorNumber.SetFocus
            Exit Sub
            End If
        If blModi Then
            If txtColorName = "" Or txtLabdipNo = "" Or txtOrderNo = "" Then
               MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
               rs.Close
               Set rs = Nothing
               txtLabdipNo.SetFocus
               Exit Sub
            End If
               
            If Not rs.EOF Then
                MsgBox "此顏色已存在！", vbCritical, "提示"
                txtColorName.Text = ""
                txtColorName.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
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtLabdipNo.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!ColorName = Trim$(txtColorName)
        rs.Fields!eColorName = Trim$(txteColorName)
        rs.Fields!Color = Trim$(ComColor)
        rs.Fields!ColorNumber = txtColorNumber
        rs.Fields!LabdipDate = Trim$(txtLabdipDate)
        rs.Fields!ReviewsDate = Trim$(txtReviewsDate)
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        rs.Open "select Color from tBeforeLabdipColor where Color=0 and LabdipNo='" & txtLabdipNo & "'"
        If rs.BOF Or rs.EOF Then
           frmBeforeInfo.chkColor.Value = 1
        Else
           frmBeforeInfo.chkColor.Value = 0
        End If
        Set rs = Nothing
        frmBeforeInfo.FillMshf2 ("select * from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'")
        Unload Me
        Exit Sub
    End If
    If viewFlag = "subColor" Then
        On Error GoTo errHandle
        If blModi Then
        strSql = "select * from tBeforeLabdipColorSub"
        rs.Open strSql
            If subColorName = "" Or subLabdipNo = "" Or subOrderNo = "" Then
               MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
               rs.Close
               Set rs = Nothing
               subLabdipNo.SetFocus
               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 tBeforeLabdipColorsub where id=" & subId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                subLabdipNo.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$(subLabdipNo)
        rs.Fields!OrderNo = Trim$(subOrderNo)
        rs.Fields!ColorName = Trim$(subColorName)
        rs.Fields!Color = Trim$(subColor)
        rs.Fields!Reviews = Trim$(subReviews)
        rs.Fields!FactoryName = Trim$(subFactoryName)
        rs.Fields!LabdipDate = subLabdipDate.Value
        rs.Fields!ReviewsDate = subReviewsDate.Value
        rs.Fields!UpdateOperator = Trim$(subUpdateOperator)
        rs.Fields!UpdateDate = Now
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        If subColor.Text = True Then
        Set mycomm = New ADODB.Command
         With mycomm
            .ActiveConnection = cn
            .CommandText = "pModiColor"
            .CommandType = 4
            .Prepared = True
            .Parameters.Append .CreateParameter("@Color", 20, 1, 1, subColor)
            .Parameters.Append .CreateParameter("@ColorName", 129, 1, 50, subColorName)
            .Execute
         End With
         rs.Open ("select Color from tBeforeLabdipColor where Color = 0")
         If rs.EOF Or rs.BOF Then
            frmBeforeInfo.chkColor.Value = 1
         End If
         rs.Close
         Set rs = Nothing
         frmBeforeInfo.FillMshf2 ("select * from tBeforeLabdipColor where LabdipNo='" & subLabdipNo & "'")
        End If
        frmBeforeInfo.FillMshf3 ("select * from tBeforeLabdipColorSub where LabdipNo='" & subLabdipNo & "'")
        Unload Me
        Exit Sub
    End If
    If viewFlag = "Layout" Then
        On Error GoTo errHandle
        If IsNumeric(txtLayoutNumber) = False Then
            MsgBox "請在次數上填寫數字", vbCritical, "提示"
            rs.Close
            Set rs = Nothing
            txtLayoutNumber.SetFocus
            Exit Sub
            End If
        If blModi Then
        strSql = "select * from tBeforeLabdipLayout"
        rs.Open strSql
            If LayoutLabdipNo = "" Or LayoutOrderNo = "" Or txtLayoutName = "" Then
               MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
               rs.Close
               Set rs = Nothing
               LayoutLabdipNo.SetFocus
               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 tBeforeLabdipLayout where id=" & LayoutId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                LayoutLabdipNo.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$(LayoutLabdipNo)
        rs.Fields!OrderNo = Trim$(LayoutOrderNo)
        rs.Fields!LayoutName = Trim$(txtLayoutName)
        rs.Fields!eLayoutName = Trim$(txteLayoutName)
        rs.Fields!Layout = Trim$(txtLayout)
        rs.Fields!LayoutNumber = Trim$(txtLayoutNumber)
        rs.Fields!LabdipDate = LayoutLabdipDate.Value
        rs.Fields!ReviewsDate = LayoutReviewsDate.Value
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        rs.Open "select Layout from tBeforeLabdipLayout where Layout=0 and LabdipNo='" & LayoutLabdipNo & "'"
        If rs.BOF Or rs.EOF = 0 Then
           frmBeforeInfo.chkType.Value = 1
        Else
           frmBeforeInfo.chkType.Value = 0
        End If
        Set rs = Nothing
        frmBeforeInfo.FillMshf4 ("select * from tBeforeLabdipLayout where LabdipNo='" & LayoutLabdipNo & "'")
        Unload Me
        Exit Sub
    End If
    If viewFlag = "subLayout" Then
        On Error GoTo errHandle
        If blModi Then
        strSql = "select * from tBeforeLabdipLayoutSub"
        rs.Open strSql
            If subLayoutLabdipNo = "" Or subLayoutOrderNo = "" Or subLayoutName = "" Then
               MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
               rs.Close
               Set rs = Nothing
               subLayoutLabdipNo.SetFocus
               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 tBeforeLabdipLayoutSub where id=" & subLayoutId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                subLayoutLabdipNo.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$(subLayoutLabdipNo)
        rs.Fields!OrderNo = Trim$(subLayoutOrderNo)
        rs.Fields!LayoutName = Trim$(subLayoutName)
        rs.Fields!Layout = Trim$(subLayout)
        rs.Fields!Reviews = Trim$(LayoutReviews)
        rs.Fields!FactoryName = Trim$(subLayoutFactoryName)
        rs.Fields!LabdipDate = subLayoutLabdipDate.Value
        rs.Fields!ReviewsDate = subLayoutReviewsDate.Value
        rs.Fields!UpdateOperator = subUpdateOperator
        rs.Fields!UpdateDate = Now
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        If subLayout.Text = True Then
        Set mycomm = New ADODB.Command
         With mycomm
            .ActiveConnection = cn
            .CommandText = "pModiLayout"
            .CommandType = 4
            .Prepared = True
            .Parameters.Append .CreateParameter("@Layout", 20, 1, 1, subLayout)
            .Parameters.Append .CreateParameter("@LayoutName", 129, 1, 50, subLayoutName)
            .Execute
         End With
         rs.Open ("select Layout from tBeforeLabdipLayout where Layout = 0")
         If rs.EOF Or rs.BOF Then
            frmBeforeInfo.chkType.Value = 1
         End If
         rs.Close
         Set rs = Nothing
         frmBeforeInfo.FillMshf4 ("select * from tBeforeLabdipLayout where LabdipNo='" & subLayoutLabdipNo & "'")
        End If
        frmBeforeInfo.FillMshf6 ("select * from tBeforeLabdipLayoutSub where LabdipNo='" & subLayoutLabdipNo & "'")
        Unload Me
        Exit Sub
    End If
    If viewFlag = "Placement" Then
        On Error GoTo errHandle
        If blModi Then
        strSql = "select * from tBeforeLabdipReference"
        rs.Open strSql
            If RefLabdipNo = "" Or RefOrderNo = "" Or Reference = "" Then
               MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
               rs.Close
               Set rs = Nothing
               Reference.SetFocus
               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 tBeforeLabdipReference where id=" & refId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                subLayoutLabdipNo.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$(RefLabdipNo)
        rs.Fields!OrderNo = Trim$(RefOrderNo)
        rs.Fields!Reference = Trim$(Reference)
        rs.Fields!Placement = Trim$(Placement)
        rs.Fields!Washing = Washing
        rs.Fields!UpdateOperator = RefUpdateOperator
        rs.Fields!UpdateDate = Now
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        Set rs = Nothing
        frmBeforeInfo.FillMshf5 ("select * from tBeforeLabdipReference where LabdipNo='" & RefLabdipNo & "'")
        Unload Me
        Exit Sub
    End If
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub