frmshipmentsinfo.frm

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

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 ComPortName, "PortName", "tBasicPort"
    Initcbb ComCountriesName, "CountriesName", "tBasicCountries"
    Initcbb ComFactoryName, "FactoryName", "tBasicFactory"
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
    InitTitle
End Sub
Private Sub InitTitle()
    Label1.Caption = "裝貨編號"
    Label2.item(0).Caption = "日期"
    Label2.item(1).Caption = "國家名稱"
    Label2.item(2).Caption = "港口名稱"
    Label2.item(6).Caption = "出貨工廠"
    Label2.item(5).Caption = "工廠聯繫人"
    Label2.item(9).Caption = "客戶編號"
    Label2.item(8).Caption = "客戶全稱"
    Label2.item(12).Caption = "運輸聯繫人"
    Label3.Caption = "運輸"
    Label4.Caption = "地址"
    Label5.Caption = "電話"
    Label6.Caption = "傳真"
    Label7.Caption = "客戶聯繫人"
    Label8.Caption = "備註"
    Label9.Caption = "其它備註"
    Label10.Caption = "填寫人"
    Label11.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
        If MSHF1.TextMatrix(lngrow, 16) = "" Then
            MsgBox "沒有可刪除的數據", vbCritical, "提示"
            Exit Sub
        End If
        strSql = "delete from tShipmentsNoticesSub where id=" & MSHF1.TextMatrix(lngrow, 16)
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        FillMshf1 ("select * from tShipmentsNoticesSub where NoticesNo='" & txtNoticesNo & "'")
    Exit Sub
errHandle:
   objDatabase.DatabaseError
    
End Sub
Private Sub EditOperatorInf()
    frmShipmentsSubInfo.newItem = False
    If lngrow = 1 Then
       MsgBox "請選擇記錄!", vbInformation + vbOKOnly, "提示"
       Exit Sub
    End If
    frmShipmentsSubInfo.InitInfo MSHF1.TextMatrix(lngrow, 16), MSHF1.TextMatrix(lngrow, 1)
    frmShipmentsSubInfo.newItem = False
    frmShipmentsSubInfo.Show vbModal
    ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
    ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
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 tShipmentsNotices where id=" & strId
        rs.Open strSql
        If Not rs.EOF Then
            txtNoticesNo = NullValue(rs.Fields!NoticesNo)
            txtNoticesNo.Enabled = False
            ComCountriesName = NullValue(rs.Fields!CountriesName)
            ComPortName = NullValue(rs.Fields!PortName)
            ComFactoryName = NullValue(rs.Fields!FactoryName)
            txtFactoryLinkman = NullValue(rs.Fields!FactoryLinkman)
            FoundDate = NullValue(rs.Fields!FoundDate)
            txtCustomerNo = NullValue(rs.Fields!CustomerNo)
            txtCustomerAllName = NullValue(rs.Fields!CustomerAllName)
            txtCustomerLinkman = NullValue(rs.Fields!CustomerLinkman)
            txtTransportName = NullValue(rs.Fields!TransportName)
            txtAddress = NullValue(rs.Fields!Address)
            txtTel = NullValue(rs.Fields!tel)
            txtFax = NullValue(rs.Fields!Fax)
            txtLinkman = NullValue(rs.Fields!linkman)
            txtRemarks = NullValue(rs.Fields!Remarks)
            txtOtherRemarks = NullValue(rs.Fields!OtherRemarks)
            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 txtNoticesNo = "" Then
            MsgBox "請填寫裝貨編號", vbCritical, "提示"
            txtNoticesNo.SetFocus
            Exit Sub
        End If
        If blModi Then
        strSql = "select * from tShipmentsNotices where NoticesNo='" & txtNoticesNo & "'"
        rs.Open strSql
        If rs.RecordCount >= 1 Then
            MsgBox "已有相同裝貨編號填入", vbCritical, "提示"
            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 tShipmentsNotices where id=" & txtId
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtNoticesNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!NoticesNo = txtNoticesNo
        rs.Fields!CountriesName = ComCountriesName
        rs.Fields!PortName = ComPortName
        rs.Fields!FactoryName = ComFactoryName
        rs.Fields!FactoryLinkman = txtFactoryLinkman
        rs.Fields!FoundDate = FoundDate
        rs.Fields!CustomerNo = txtCustomerNo
        rs.Fields!CustomerLinkman = txtCustomerLinkman
        rs.Fields!CustomerAllName = txtCustomerAllName
        rs.Fields!TransportName = txtTransportName
        rs.Fields!Address = txtAddress
        rs.Fields!tel = txtTel
        rs.Fields!Fax = txtFax
        rs.Fields!linkman = txtLinkman
        rs.Fields!Remarks = txtRemarks
        rs.Fields!OtherRemarks = txtOtherRemarks
        rs.Fields!UpdateOperator = txtUpdateOperator
        rs.Fields!UpdateDate = Now
        rs.Update
        MsgBox "操作成功！", vbInformation, "恭喜"
        rs.Close
         Set rs = Nothing
        frmShipments.FillMshf1 ("select * from tShipmentsNotices")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub

Public Sub FillMshf1(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 MSHF1
          .Redraw = False
          .Rows = 2
          .Cols = 17
          .Clear
          '初始化
         .WordWrap = False
         .TextMatrix(0, 0) = "序號"
         .ColWidth(0) = 500
         .TextMatrix(0, 1) = "出貨編號"
         .ColWidth(1) = 1200
         .TextMatrix(0, 2) = "加工單號"
         .ColWidth(2) = 1200
         .TextMatrix(0, 3) = "加工廠單號"
         .ColWidth(3) = 1200
         .TextMatrix(0, 4) = "布號"
         .ColWidth(4) = 1200
         .TextMatrix(0, 5) = "布名"
         .ColWidth(5) = 1500
         .TextMatrix(0, 6) = "組織"
         .ColWidth(6) = 1500
         .TextMatrix(0, 7) = "色號"
         .ColWidth(7) = 1500
         .TextMatrix(0, 8) = "交期"
         .ColWidth(8) = 1200
         .TextMatrix(0, 9) = "出貨數量"
         .ColWidth(9) = 1200
         .TextMatrix(0, 10) = "疋數"
         .ColWidth(10) = 1200
         .TextMatrix(0, 11) = "裝入倉期"
         .ColWidth(11) = 1200
         .TextMatrix(0, 12) = "貨到船開期"
         .ColWidth(12) = 1200
         .TextMatrix(0, 13) = "包裝"
         .ColWidth(13) = 1200
         .TextMatrix(0, 14) = "庫存數"
         .ColWidth(14) = 1200
         .TextMatrix(0, 15) = "客人"
         .ColWidth(15) = 2000
         .TextMatrix(0, 16) = ""
         .ColWidth(16) = 0
         '.....................................................
         .Rows = rs.RecordCount + 2
         On Error Resume Next
         For lngrow = 2 To rs.RecordCount + 1
                .TextMatrix(lngrow, 0) = lngrow - 1
                .TextMatrix(lngrow, 1) = NullValue(rs.Fields!NoticesNo)
                .TextMatrix(lngrow, 2) = NullValue(rs.Fields!OrderNo)
                .TextMatrix(lngrow, 3) = NullValue(rs.Fields!FactoryNo)
                .TextMatrix(lngrow, 4) = NullValue(rs.Fields!FabricNo)
                .TextMatrix(lngrow, 5) = NullValue(rs.Fields!FabricName)
                .TextMatrix(lngrow, 6) = NullValue(rs.Fields!Composition)
                .TextMatrix(lngrow, 7) = NullValue(rs.Fields!eLayoutColor)
                .TextMatrix(lngrow, 8) = NullValue(rs.Fields!Delivery)
                .TextMatrix(lngrow, 9) = NullValue(rs.Fields!Quantity)
                .TextMatrix(lngrow, 10) = NullValue(rs.Fields!clothamount)
                .TextMatrix(lngrow, 11) = NullValue(rs.Fields!Stockdate)
                .TextMatrix(lngrow, 12) = NullValue(rs.Fields!Shipmentsdate)
                .TextMatrix(lngrow, 13) = NullValue(rs.Fields!Packing)
                .TextMatrix(lngrow, 14) = NullValue(rs.Fields!StockAmount)
                .TextMatrix(lngrow, 15) = NullValue(rs.Fields!CustomerName)
                .TextMatrix(lngrow, 16) = NullValue(rs.Fields!ID)
                rs.MoveNext
          Next
          lngrow = 0
          .TextMatrix(1, 0) = "总计"
          .TextMatrix(1, 1) = .Rows - 2
           SetItemBackColor MSHF1
           .Redraw = True
      End With
      rs.Close
remClear:
    Set rs = Nothing
    Screen.MousePointer = vbDefault
    Exit Sub
errLabel:
    On Error Resume Next
    MSHF1.Redraw = True
    GoTo remClear
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()
   EditOperatorInf
End Sub