form1.frm

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

                        txtLabdipNo.SetFocus
                        Exit Sub
                End If
                Select Case ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex
                       Case 0:
                            frmBeforeColor.newItem = True
                            frmBeforeColor.InitInfo "", txtLabdipNo, txtOrderNo
                            frmBeforeColor.Show vbModal
                       Case 1:
                            frmBeforeColorSub.newItem = True
                            frmBeforeColorSub.InitInfo "", txtLabdipNo, txtOrderNo
                            frmBeforeColorSub.Show vbModal
                       Case 2:
                            frmBeforeLayout.newItem = True
                            frmBeforeLayout.InitInfo "", txtLabdipNo, txtOrderNo
                            frmBeforeLayout.Show vbModal
                       Case 3:
                            frmBeforeReference.newItem = True
                            frmBeforeReference.InitInfo "", txtLabdipNo, txtOrderNo, txtReference
                            frmBeforeReference.Show vbModal
                       Case Else:
                            frmBeforeColor.newItem = True
                            frmBeforeColor.InitInfo "", txtLabdipNo, txtOrderNo
                            frmBeforeColor.Show vbModal
                End Select
            Case "cmdExport":
                Dim strFile As String
                frmMain.CDFile.ShowOpen
                strFile = frmMain.CDFile.FileName
                If strFile = "" Then Exit Sub
                If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 0 Then
                     ExportExcel MSHF1, strFile
                End If
                If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 1 Then
                     ExportExcel MSHF2, strFile
                End If
                If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 2 Then
                     ExportExcel MSHF3, strFile
                End If
                If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 4 Then
                     ExportExcel MSHF6, strFile
                End If
                If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 6 Then
                    ExportExcel MSHF5, strFile
                End If
            Case "cmdPrint":
                If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 0 Then
                   Call PrintBeforeLabdip
                Else
                    If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 2 Then
                       Call PrintBeforeLayout
                    Else
                        If ActiveBar21.Bands("toolbar").Tools.item("DataView").CBListIndex = 3 Then
                           Call PrintBeforeReference
                        Else
                           Call PrintBeforeLabdip
                        End If
                    End If
                End If
    End Select
End Sub
Private Sub PrintBeforeLabdip()
   With BillReport
       .ClientName.SetText (txtClientName)
       .Season.SetText (txtSeason)
       .SeasonLine.SetText (txtSeasonLine)
       .Delivery.SetText (FormatDateStr(DTPdelivery, "long"))
       .Code.SetText (ComFabricCode)
      ' .Pattern.SetText (txtPattern)
       .ePattern.SetText (ColorLayout)
       .Reference.SetText (txtReference)
       .Dye.SetText (txtDye)
       .Finish.SetText (txtFinish)
       .Processing.SetText (txtProcessing)
       .Quality.SetText (IIf(chkQuality.Value, "OK", "NO"))
       .Color.SetText (IIf(chkColor.Value, "OK", "NO"))
       .Layout.SetText (IIf(chkType.Value, "OK", "NO"))
       .FactoryName.SetText (ComFactoryName)
       .Standard.SetText (txtStandard)
       .LateAddDate.SetText (FormatDateStr(DTPlate.Value, "Long"))
       .DropDate.SetText (FormatDateStr(DTPdrop.Value, "long"))
       .Price.SetText (txtPrice)
       .Remarks.SetText (txtRemarks)
   End With
   Dim i As Integer
   Dim rs As ADODB.Recordset
   Dim rsobj 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 tBeforeLabdipColor a,(select top 1 * from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "' order by id desc) b where"
    strSql = strSql & " a.LabdipNo='" & txtLabdipNo & "' and a.ColorName=b.ColorName"
    rs.Open strSql
    Set rsobj = New ADODB.Recordset
    With rsobj
         .LockType = adLockOptimistic
         .CursorType = adOpenDynamic
    End With
    rsobj.Fields.Append "eColorName", adVarChar, 20
    rsobj.Fields.Append "ColorName", adVarChar, 20
    rsobj.Fields.Append "Color", adVarChar, 20
    rsobj.Fields.Append "ColorNumber", adVarChar, 20
    rsobj.Fields.Append "Reviews", adVarChar, 20
    rsobj.Fields.Append "FactoryName", adVarChar, 20
    rsobj.Fields.Append "LabdipDate", adVarChar, 20
    rsobj.Fields.Append "ReviewsDate", adVarChar, 20
    rsobj.Open
    Do While Not rs.EOF
        rsobj.AddNew
        rsobj.Fields!eColorName = IIf(IsNull(rs.Fields!eColorName), "", rs.Fields!eColorName)
        rsobj.Fields!ColorName = IIf(IsNull(rs.Fields!ColorName), "", rs.Fields!ColorName)
        rsobj.Fields!Color = IIf(rs.Fields!Color, "OK", "NO")
        rsobj.Fields!ColorNumber = NullValue(rs.Fields!ColorNumber)
        rsobj.Fields!Reviews = NullValue(rs.Fields!Reviews)
        rsobj.Fields!FactoryName = NullValue(rs.Fields!FactoryName)
        rsobj.Fields!LabdipDate = FormatDateStr(rs.Fields!LabdipDate, "long")
        rsobj.Fields!ReviewsDate = FormatDateStr(rs.Fields!ReviewsDate, "long")
        rsobj.Update
        rs.MoveNext
    Loop
    If rs.RecordCount < 7 Then
        For i = rs.RecordCount To 7
        rsobj.AddNew
        rsobj.Fields!eColorName = ""
        rsobj.Fields!ColorName = ""
        rsobj.Fields!Color = ""
        rsobj.Fields!ColorNumber = ""
        rsobj.Fields!Reviews = ""
        rsobj.Fields!FactoryName = ""
        rsobj.Fields!LabdipDate = ""
        rsobj.Fields!ReviewsDate = ""
        rsobj.Update
        Next
    End If
    BillReport.dataBase.SetDataSource rsobj
    rs.Close
    Set rs = Nothing
    rsobj.Close
    Set rsobj = Nothing
    frmReportLabdip.Show vbModal
End Sub
Private Sub PrintBeforeLayout()
   With BillReportLayout
       .ClientName.SetText (txtClientName)
       .Season.SetText (txtSeason)
       .SeasonLine.SetText (txtSeasonLine)
       .Delivery.SetText (FormatDateStr(DTPdelivery, "long"))
       .Code.SetText (ComFabricCode)
      ' .Pattern.SetText (txtPattern)
       .ePattern.SetText (ColorLayout)
       .Reference.SetText (txtReference)
       .Dye.SetText (txtDye)
       .Finish.SetText (txtFinish)
       .Processing.SetText (txtProcessing)
       .Quality.SetText (IIf(chkQuality.Value, "OK", "NO"))
       .Color.SetText (IIf(chkColor.Value, "OK", "NO"))
       .Layout.SetText (IIf(chkType.Value, "OK", "NO"))
       .FactoryName.SetText (ComFactoryName)
       .Standard.SetText (txtStandard)
       .LateAddDate.SetText (FormatDateStr(DTPlate.Value, "Long"))
       .DropDate.SetText (FormatDateStr(DTPdrop.Value, "long"))
       .Price.SetText (txtPrice)
       .Remarks.SetText (txtRemarks)
    End With
    Dim i, iRows As Integer
   Dim rs As ADODB.Recordset
  Set rs = New ADODB.Recordset
  With rs
      .LockType = adLockOptimistic
      .CursorType = adOpenDynamic
  End With
  rs.Fields.Append "LayoutName", adVarChar, 50
  rs.Fields.Append "Layout", adVarChar, 10
  rs.Fields.Append "Reviews", adVarChar, 20
  rs.Fields.Append "FactoryName", adVarChar, 20
  rs.Fields.Append "LabdipDate", adVarChar, 20
  rs.Fields.Append "ReviewsDate", adVarChar, 20
  rs.Open
  With Me.MSHF6
       iRows = .Rows - 2
       For i = 2 To iRows + 1
            rs.AddNew
            rs.Fields!LayoutName = .TextMatrix(i, 1)
            rs.Fields!Layout = .TextMatrix(i, 2)
            rs.Fields!Reviews = .TextMatrix(i, 3)
            rs.Fields!FactoryName = .TextMatrix(i, 4)
            rs.Fields!LabdipDate = .TextMatrix(i, 5)
            rs.Fields!ReviewsDate = .TextMatrix(i, 6)
            rs.Update
        Next
      If iRows < 6 Then
         For i = iRows + 1 To 6
            rs.AddNew
            rs.Fields!LayoutName = ""
            rs.Fields!Layout = ""
            rs.Fields!Reviews = ""
            rs.Fields!FactoryName = ""
            rs.Fields!LabdipDate = ""
            rs.Fields!ReviewsDate = ""
            rs.Update
         Next
      End If
  End With
    BillReportLayout.dataBase.SetDataSource rs
    rs.Close
    Set rs = Nothing
    frmReportLayout.Show vbModal
End Sub
Private Sub PrintBeforeReference()
   With BillReportReference
        .ClientName.SetText (txtClientName)
       .Season.SetText (txtSeason)
       .SeasonLine.SetText (txtSeasonLine)
       .Delivery.SetText (FormatDateStr(DTPdelivery, "long"))
       .Code.SetText (ComFabricCode)
      ' .Pattern.SetText (txtPattern)
       .ePattern.SetText (ColorLayout)
       .Reference.SetText (txtReference)
       .Dye.SetText (txtDye)
       .Finish.SetText (txtFinish)
       .Processing.SetText (txtProcessing)
       .Quality.SetText (IIf(chkQuality.Value, "OK", "NO"))
       .Color.SetText (IIf(chkColor.Value, "OK", "NO"))
       .Layout.SetText (IIf(chkType.Value, "OK", "NO"))
       .FactoryName.SetText (ComFactoryName)
       .Standard.SetText (txtStandard)
       .LateAddDate.SetText (FormatDateStr(DTPlate.Value, "Long"))
       .DropDate.SetText (FormatDateStr(DTPdrop.Value, "long"))
       .Price.SetText (txtPrice)
       .Remarks.SetText (txtRemarks)
   End With
   Dim i, iRows As Integer
   Dim rs As ADODB.Recordset
  Set rs = New ADODB.Recordset
  With rs
      .LockType = adLockOptimistic
      .CursorType = adOpenDynamic
  End With
  rs.Fields.Append "Reference", adVarChar, 20
  rs.Fields.Append "Placement", adVarChar, 50
  rs.Fields.Append "Washing", adVarChar, 20
  rs.Open
  With Me.MSHF5
       iRows = .Rows - 2
       For i = 2 To iRows + 1
            rs.AddNew
            rs.Fields!Reference = .TextMatrix(i, 1)
            rs.Fields!Placement = .TextMatrix(i, 2)
            rs.Fields!Washing = .TextMatrix(i, 3)
            rs.Update
        Next
      If iRows < 6 Then
         For i = iRows + 1 To 6
            rs.AddNew
            rs.Fields!Reference = ""
            rs.Fields!Placement = ""
            rs.Fields!Washing = ""
            rs.Update
         Next
      End If
  End With
    BillReportReference.dataBase.SetDataSource rs
    rs.Close
    Set rs = Nothing
    frmReportReference.Show vbModal
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  tBeforeLabdip  where labdipNo='" & txtLabdipNo & "'"
        objDatabase.ExecCmd strSql
        strSql = "delete from tBeforeLabdipReference where LabdipNo='" & txtLabdipNo & "'"
        objDatabase.ExecCmd strSql
        strSql = "delete from tBeforeLabdipColor where LabdipNo='" & txtLabdipNo & "'"
        objDatabase.ExecCmd strSql
        strSql = "delete from tBeforeLabdipColorSub where LabdipNo='" & txtLabdipNo & "'"
        objDatabase.ExecCmd strSql
        strSql = "delete from tBeforeLabdipLayoutSub where LabdipNo='" & txtLabdipNo & "'"
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
    frmBeforeMain.FillMshf1 ("select * from tBeforeLabdip,tBeforeLabdipReference where tBeforeLabdip.Reference=tBeforeLabdipReference.Reference")
    Unload Me
    Exit Sub
errHandle:

   objDatabase.DatabaseError
    
End Sub
Public Sub FillMshf6(ByVal strSql As String)
   Dim rs As ADODB.Recordset
   Dim lngrow As Long
      Screen.MousePointer = vbHourglass
      On Error GoTo errLabel
      Set rs = New ADODB.Recordset
      With rs
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        Set .ActiveConnection = Cn
      End With
      rs.Open strSql
      With MSHF6
          .Redraw = False
          .Rows = 2
          .Cols = 10
          .Clear
          '初始化
         .WordWrap = False
         .TextMatrix(0, 0) = "序號"
         .ColWidth(0) = 500
         .TextMatrix(0, 1) = "花型名稱"
         .ColWidth(1) = 1200
         .TextMatrix(0, 2) = "結果"
         .ColWidth(2) = 800
         .TextMatrix(0, 3) = "評語"
         .ColWidth(3) = 1500
         .TextMatrix(0, 4) = "加工廠"
         .ColWidth(4) = 1200
         .TextMatrix(0, 5) = "上批日期"
         .ColWidth(5) = 1000
         .TextMatrix(0, 6) = "評語日期"
         .ColWidth(6) = 1000
         .TextMatrix(0, 7) = "填寫人"
         .ColWidth(7) = 1000
         .TextMatrix(0, 8) = "填寫日期"
         .ColWidth(8) = 1000
         .TextMatrix(0, 9) = ""
         .ColWidth(9) = 0
         '.....................................................
         .Rows = rs.RecordCount + 2
         On Error Resume Next
         For lngrow = 2 To rs.RecordCount + 1
                .TextMatrix(lngrow, 0) = lngrow - 1
                .TextMatrix(lngrow, 1) = Trim$(NullValue(rs.Fields!LayoutName))
                .TextMatrix(lngrow, 2) = IIf(rs.Fields!Layout, "OK", "NO")
                .TextMatrix(lngrow, 3) = Trim$(NullValue(rs.Fields!Reviews))
                .TextMatrix(lngrow, 4) = Trim$(NullValue(rs.Fields!FactoryName))
                .TextMatrix(lngrow, 5) = Trim$(NullValue(rs.Fields!LabdipDate))
                .TextMatrix(lngrow, 6) = Trim$(NullValue(rs.Fields!ReviewsDate))
                .TextMatrix(lngrow, 7) = Trim$(NullValue(rs.Fields!UpdateOperator))