frmshipmentsinfo.frm

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

            Width           =   915
         End
         Begin VB.Label Label6 
            Caption         =   "傳真"
            Height          =   315
            Left            =   360
            TabIndex        =   20
            Top             =   2880
            Width           =   915
         End
         Begin VB.Label Label5 
            Caption         =   "電話"
            Height          =   315
            Left            =   4380
            TabIndex        =   19
            Top             =   2400
            Width           =   915
         End
         Begin VB.Label Label4 
            Caption         =   "地址"
            Height          =   315
            Left            =   360
            TabIndex        =   18
            Top             =   2460
            Width           =   1035
         End
         Begin VB.Label Label3 
            Caption         =   "運輸"
            Height          =   315
            Left            =   4380
            TabIndex        =   17
            Top             =   1980
            Width           =   855
         End
         Begin VB.Label Label2 
            Caption         =   "港口名稱"
            Height          =   255
            Index           =   2
            Left            =   4380
            TabIndex        =   15
            Top             =   780
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "日期"
            Height          =   255
            Index           =   0
            Left            =   4380
            TabIndex        =   14
            Top             =   360
            Width           =   735
         End
         Begin VB.Label Label2 
            Caption         =   "國家名稱"
            Height          =   255
            Index           =   1
            Left            =   360
            TabIndex        =   13
            Top             =   780
            Width           =   1035
         End
         Begin VB.Label Label1 
            Caption         =   "裝貨編號"
            Height          =   255
            Left            =   360
            TabIndex        =   12
            Top             =   360
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "出貨工廠"
            Height          =   255
            Index           =   6
            Left            =   360
            TabIndex        =   11
            Top             =   1200
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "工廠聯繫人"
            Height          =   255
            Index           =   5
            Left            =   4380
            TabIndex        =   10
            Top             =   1200
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "客戶全稱"
            Height          =   255
            Index           =   8
            Left            =   4380
            TabIndex        =   9
            Top             =   1620
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "客戶編號"
            Height          =   255
            Index           =   9
            Left            =   360
            TabIndex        =   8
            Top             =   1620
            Width           =   1035
         End
         Begin VB.Label Label2 
            Caption         =   "運輸聯繫人"
            Height          =   255
            Index           =   12
            Left            =   4380
            TabIndex        =   7
            Top             =   2880
            Width           =   1035
         End
      End
   End
End
Attribute VB_Name = "frmShipmentsInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加
Dim lngrow As Long
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
            Case "cmdSave":
                 Save newItem
           Case "cmdCancel":
                Unload Me
           Case "cmdAdd":
                frmShipmentsSubInfo.txtNoticesNo = txtNoticesNo
                frmShipmentsSubInfo.newItem = True
                frmShipmentsSubInfo.CustomerNo = txtCustomerNo
                frmShipmentsSubInfo.Show vbModal
            Case "cmdEdit"
                 EditOperatorInf
            Case "cmdDel":
                DelOperatorInf
            Case "cmdPrint"
                Call PrintNotices
            Case "cmdExport":
                Dim strFile As String
                frmMain.CDFile.ShowOpen
                strFile = frmMain.CDFile.FileName
                If strFile = "" Then Exit Sub
                ExportExcel MSHF1, strFile
    End Select
End Sub
Private Sub PrintNotices()
   Dim tempValue1, tempValue2 As Integer
    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 "OrderNo", adVarChar, 20
  rs.Fields.Append "FactoryNo", adVarChar, 20
  rs.Fields.Append "Composition", adVarChar, 50
  rs.Fields.Append "FabricName", adVarChar, 20
  rs.Fields.Append "LayoutName", adVarChar, 20
  rs.Fields.Append "Quantity", adVarChar, 20
  rs.Fields.Append "ClothAmount", adVarChar, 20
  rs.Fields.Append "stockdate", adVarChar, 20
  rs.Fields.Append "shipmentsdate", adVarChar, 20
  rs.Fields.Append "packing", adVarChar, 20
  rs.Fields.Append "CustomerName", adVarChar, 20
  rs.Open
  With Me.MSHF1
       iRows = .Rows - 2
       For i = 2 To iRows + 1
            tempValue1 = tempValue1 + CInt(.TextMatrix(i, 9))
            tempValue2 = tempValue2 + CInt(.TextMatrix(i, 10))
            rs.AddNew
            rs.Fields!OrderNo = .TextMatrix(i, 1)
            rs.Fields!FactoryNo = .TextMatrix(i, 2)
            rs.Fields!Composition = .TextMatrix(i, 6)
            rs.Fields!FabricName = .TextMatrix(i, 5)
            rs.Fields!LayoutName = .TextMatrix(i, 7)
            rs.Fields!Quantity = .TextMatrix(i, 9)
            rs.Fields!clothamount = .TextMatrix(i, 10)
            rs.Fields!Stockdate = .TextMatrix(i, 11)
            rs.Fields!Shipmentsdate = .TextMatrix(i, 12)
            rs.Fields!Packing = .TextMatrix(i, 13)
            rs.Fields!CustomerName = .TextMatrix(i, 15)
            rs.Update
        Next
      If iRows < 7 Then
         For i = iRows + 1 To 7
            rs.AddNew
            rs.Fields!OrderNo = ""
            rs.Fields!FactoryNo = ""
            rs.Fields!Composition = ""
            rs.Fields!FabricName = ""
            rs.Fields!LayoutName = ""
            rs.Fields!Quantity = ""
            rs.Fields!clothamount = ""
            rs.Fields!Stockdate = ""
            rs.Fields!Shipmentsdate = ""
            rs.Fields!Packing = ""
            rs.Fields!CustomerName = ""
            rs.Update
         Next
      End If
  End With
    With BillReportNotices
       .NoticesNo.SetText (txtNoticesNo)
       .CountriesName.SetText (ComCountriesName)
       .txtPortname.SetText (ComPortName)
       .FactoryName.SetText (ComFactoryName)
       .FactoryLinkman.SetText (txtFactoryLinkman)
       .TransportName.SetText (txtTransportName)
       .Address.SetText (txtAddress)
       .tel.SetText (txtTel)
       .linkman.SetText (txtLinkman)
       .QuantitySum.SetText (tempValue1)
       .ClothAmountSum.SetText (tempValue2)
   End With
    BillReportNotices.dataBase.SetDataSource rs
    rs.Close
    Set rs = Nothing
    frmReportNotices.Show vbModal
End Sub

Private Sub CmdId_Click()
    frnPic.Visible = True
    Dim rs As New ADODB.Recordset
    rs.Open "select id from tShipmentsNotices", Cn, 1, 3
    If rs.EOF Or rs.BOF Then
       txtShipmentsId = "0001"
       Exit Sub
    End If
    rs.MoveLast
    txtShipmentsId = String(4 - Len(rs.Fields!ID + 1), "0") & rs.Fields!ID + 1
    rs.Close
    Set rs = Nothing
End Sub

Private Sub CmdNoticesCancel_Click()
    frnPic.Visible = False
End Sub

Private Sub CmdNoticesOk_Click()
    txtNoticesNo = txtHead + txtShipmentsId
    frnPic.Visible = False
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)
            txtCustomerLinkman = 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
            txtAddress = rs.Fields!Address
            txtTel = rs.Fields!tel
            txtFax = rs.Fields!Fax
            txtLinkman = rs.Fields!linkman
        End If
    rs.Close