frmshipmentstodoinfo.frm

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

  rs.Open
  With Me.MSHF1
       iRows = .Rows - 2
       For i = 2 To iRows + 1
            rs.AddNew
            rs.Fields!ContractNo = .TextMatrix(i, 1)
            rs.Fields!FabricNo = .TextMatrix(i, 2)
            rs.Fields!col = .TextMatrix(i, 3)
            rs.Fields!Quantity = .TextMatrix(i, 4)
            rs.Update
        Next
'      If iRows < 3 Then
'         For i = iRows + 1 To 4
'            rs.AddNew
'            rs.Fields!ContractNo = ""
'            rs.Fields!FabricNo = ""
'            rs.Fields!col = ""
'            rs.Fields!Quantity = ""
'            rs.Update
'         Next
'      End If
  End With
    BillReportShipmentsTodo.dataBase.SetDataSource rs
    rs.Close
    Set rs = Nothing
    frmReportShimentsTodo.Show vbModal
End Sub
Private Sub cmdOk_Click()
   If txtPatternNo = "" Then
       MsgBox "請先選擇出辦編號及客戶信息", vbInformation + vbOKOnly, "提示"
       Exit Sub
   End If
   frmShipmentsPatternSelect.ReadCustomerPurveyInf
   frmShipmentsPatternSelect.Show vbModal
End Sub

Private Sub CmdCustomer_Click()
    frmCustomerSelect.Show vbModal
    GetCustomerInfo frmCustomerSelect.CustomerNo
End Sub
Private Sub GetCustomerInfo(CustomerNo 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 tCustomer where CustomerNo=" & objDatabase.FormatSQL(CustomerNo)
        If Not rs.EOF Then
            txtCustomerAllName = NullValue(rs.Fields!CustomerAllName)
            txtCustomerNo = NullValue(rs.Fields!CustomerNo)
            txtLinkman = NullValue(rs.Fields!Linkman)
        End If
    rs.Close

remClear:
    Set rs = Nothing
    Exit Sub
errLabel:
    objDatabase.DatabaseError
    GoTo remClear
End Sub
Private Sub CmdTransport_Click()
    frmTransportSelect.Show vbModal
    GetTransportInfo frmTransportSelect.TransportName
End Sub
Private Sub GetTransportInfo(TransportName 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 tBasicTransport where TransportName=" & objDatabase.FormatSQL(TransportName)
        If Not rs.EOF Then
            txtTransportName = rs.Fields!TransportName
            txtTransportNo = rs.Fields!TransportNo
            
        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
    InitTitle
    cmdOk.Enabled = False
    txtReInfo.AddItem ("GYM APPROVED SAMPLE")
    txtReInfo.AddItem ("OUTLEFT APPROVED SAMPLE")
    txtReInfo.AddItem ("JJ APPROVED SAMPLE")
    txtReInfo.AddItem ("C8 APPROVED SAMPLE")
    txtReInfo.AddItem ("GYM SUBSTITUTE SAMPLE")
    txtReInfo.AddItem ("OUTLEFT SUBSTITUTE SAMPLE")
    txtReInfo.AddItem ("JJ SUBSTITUTE SAMPLE")
    txtReInfo.AddItem ("C8 SUBSTITUTE SAMPLE")
    txtReInfo.AddItem ("GYM WAIT APPROVAL SHIPMENT")
    txtReInfo.AddItem ("OUTLEFT WAIT APPROVAL SHIPMENT")
    txtReInfo.AddItem ("JJ WAIT APPROVAL SHIPMENT")
    txtReInfo.AddItem ("C8 WAIT APPROVAL SHIPMENT")
End Sub
Private Sub InitTitle()
    Label1.Caption = "編號"
    Label2.item(0).Caption = "日期"
    Label2.item(1).Caption = "客戶編號"
    Label2.item(2).Caption = "客戶全稱"
    Label2.item(6).Caption = "聯繫人"
    Label3.Caption = "快遞公司"
    Label4.Caption = "快遞編號"
    Label5.Caption = "快遞日期"
    Label2.item(12).Caption = "信息源"
    Label6.Caption = "備註"
    Label10.Caption = "填寫人"
    Label12.Caption = "填寫日期"
    cmdOk.Caption = "選擇合约"
    Me.Caption = "出辦通知書"
End Sub
Public Sub FillMshf1(ByVal strSql As String)
Dim rs As ADODB.Recordset
   Dim strCap As String
      strCap = Me.Caption
      Me.Caption = "正在读取资料..."
      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
      On Error GoTo errLabel
      With MSHF1
          .Redraw = False
          .Rows = 2
          .Cols = 7
          .Clear
          '初始化
         .WordWrap = False
         .TextMatrix(0, 0) = "序號"
         .ColWidth(0) = 500
         .TextMatrix(0, 1) = "合約編號"
         .ColWidth(1) = 1000
         .TextMatrix(0, 2) = "布號"
         .ColWidth(2) = 1000
         .TextMatrix(0, 3) = "顏色花型"
         .ColWidth(3) = 1200
         .TextMatrix(0, 4) = "出辦數量"
         .ColWidth(4) = 1200
         .TextMatrix(0, 5) = "出辦編號"
         .ColWidth(5) = 1200
         .TextMatrix(0, 6) = ""
         .ColWidth(6) = 0
         '.....................................................
         .Rows = rs.RecordCount + 2
         'On Error Resume Next
         Dim i As Integer
         For lngrow = 2 To rs.RecordCount + 1
                .TextMatrix(lngrow, 0) = lngrow - 1
                .TextMatrix(lngrow, 1) = NullValue(rs.Fields!ContractNo)
                .TextMatrix(lngrow, 2) = NullValue(rs.Fields!FabricNo)
                .TextMatrix(lngrow, 3) = NullValue(rs.Fields!eLayoutColor)
                .TextMatrix(lngrow, 4) = NullValue(rs.Fields!ShipmentsPatternAmount)
                .TextMatrix(lngrow, 5) = NullValue(rs.Fields!ShipmentsPatternNo)
                .TextMatrix(lngrow, 6) = NullValue(rs.Fields!ID)
               ' .TextMatrix(lngrow, 5) = NullValue(rs.Fields!shipmentsno)
                rs.MoveNext
          Next
          lngrow = 0
          .TextMatrix(1, 0) = "总计"
          .TextMatrix(1, 1) = .Rows - 2
           SetItemBackColor MSHF1
          .Redraw = True
      End With
      rs.Close
      Set rs = Nothing
      Me.Caption = strCap
      Screen.MousePointer = vbDefault
remClear:
    Set rs = Nothing
    Me.Caption = strCap
    Screen.MousePointer = vbDefault
    Exit Sub
errLabel:
    On Error Resume Next
    MSHF1.Redraw = True
    GoTo remClear
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 tShipmentsPattern a,tBusinessContractSub b where b.ShipmentsPatternNo=a.PatternNo"
        rs.Open strSql
        If Not rs.EOF Then
            txtPatternNo = NullValue(rs.Fields!PatternNo)
            Founddate = NullValue(rs.Fields!Founddate)
            txtCustomerNo = NullValue(rs.Fields!CustomerNo)
            txtCustomerAllName = NullValue(rs.Fields!CustomerAllName)
            txtLinkman = NullValue(rs.Fields!Linkman)
            txtReInfo = NullValue(rs.Fields!ReInfo)
            txtFromInfo = NullValue(rs.Fields!fromInfo)
            txtTransportName = NullValue(rs.Fields!TransportName)
            txtTransportNo = NullValue(rs.Fields!TransportNo)
            TransportDate = NullValue(rs.Fields!TransportDate)
            txtUpdateOperator = NullValue(rs.Fields!UpdateOperator)
            txtUpdateDate = NullValue(rs.Fields!UpdateDate)
            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 txtPatternNo = "" Then
            MsgBox "請填寫出辦編號", vbCritical, "提示"
            txtPatternNo.SetFocus
            Exit Sub
        End If
        If blModi Then
        strSql = "select * from tShipmentsPattern"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
                    
            rs.AddNew '新建
        Else
            strSql = "select * from tShipmentsPattern where PatternNo='" & txtPatternNo & "'"
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtPatternNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!PatternNo = txtPatternNo
        rs.Fields!Founddate = Founddate
        rs.Fields!CustomerNo = txtCustomerNo
        rs.Fields!CustomerAllName = txtCustomerAllName
        rs.Fields!Linkman = txtLinkman
        rs.Fields!ReInfo = txtReInfo
        rs.Fields!fromInfo = txtFromInfo
        rs.Fields!TransportName = txtTransportName
        rs.Fields!TransportNo = txtTransportNo
        rs.Fields!TransportDate = TransportDate
        rs.Fields!UpdateOperator = txtUpdateOperator
        rs.Fields!UpdateDate = Now
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
        Set rs = Nothing
        For lngrow = 2 To MSHF1.Rows - 1
        objDatabase.ExecCmd ("update tBusinessContractSub set ShipmentsPatternNo='" & txtPatternNo & "' where ContractNo='" & MSHF1.TextMatrix(lngrow, 1) & "'")
        Next lngrow
        frmShipmentsTodo.FillMshf1 ("select * from vShipmentsPattern")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub
Private Sub MSHF1_Click()
    lngrow = Val(MSHF1.row)
       MSHF1.row = lngrow
        MSHF1.col = 0
        MSHF1.ColSel = MSHF1.Cols - 1
        ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = True
        ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = True
End Sub

Private Sub MSHF1_DblClick()
   If lngrow = 1 Then
       MsgBox "請選擇記錄!", vbInformation + vbOKOnly, "提示"
       Exit Sub
    End If
    With frmShipmentsTodoInfoEdit
         .txtContractNo = MSHF1.TextMatrix(lngrow, 1)
         .txtFabricNo = MSHF1.TextMatrix(lngrow, 2)
         .txtColorLayout = MSHF1.TextMatrix(lngrow, 3)
         .txtShipmentsPatternAmount = MSHF1.TextMatrix(lngrow, 4)
         .lngrow = lngrow
    End With
    frmShipmentsTodoInfoEdit.Show vbModal
End Sub

Private Sub txtCustomerNo_Change()
    cmdOk.Enabled = True
End Sub