frmshipmentsinvoiceinfo.frm

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

            End
            Begin VB.Label Label10 
               Caption         =   "填寫人"
               Height          =   255
               Left            =   6000
               TabIndex        =   44
               Top             =   1260
               Width           =   735
            End
            Begin VB.Label Label20 
               Caption         =   "單價"
               Height          =   315
               Left            =   180
               TabIndex        =   28
               Top             =   780
               Width           =   375
            End
            Begin VB.Label Label15 
               Caption         =   "原產地"
               Height          =   255
               Left            =   3420
               TabIndex        =   17
               Top             =   1260
               Width           =   855
            End
            Begin VB.Label Label13 
               Caption         =   "付款方式"
               Height          =   255
               Left            =   6000
               TabIndex        =   14
               Top             =   780
               Width           =   735
            End
            Begin VB.Label Label14 
               Caption         =   "交期"
               Height          =   255
               Left            =   6000
               TabIndex        =   13
               Top             =   300
               Width           =   675
            End
            Begin VB.Label Label3 
               Caption         =   "幣種"
               Height          =   315
               Left            =   3420
               TabIndex        =   11
               Top             =   780
               Width           =   675
            End
            Begin VB.Label Label2 
               Caption         =   "客戶編號"
               Height          =   255
               Index           =   1
               Left            =   180
               TabIndex        =   10
               Top             =   300
               Width           =   1035
            End
            Begin VB.Label Label2 
               Caption         =   "客戶名稱"
               Height          =   255
               Index           =   2
               Left            =   3420
               TabIndex        =   9
               Top             =   300
               Width           =   1035
            End
         End
         Begin VB.TextBox txtInvoiceNo 
            BackColor       =   &H00C0C0FF&
            Enabled         =   0   'False
            Height          =   315
            Left            =   1500
            MaxLength       =   20
            TabIndex        =   3
            Top             =   300
            Width           =   1995
         End
         Begin VB.TextBox txtId 
            Height          =   270
            Left            =   2940
            TabIndex        =   2
            Top             =   1680
            Visible         =   0   'False
            Width           =   435
         End
         Begin MSComCtl2.DTPicker FoundDate 
            Height          =   315
            Left            =   5520
            TabIndex        =   4
            Top             =   300
            Width           =   1995
            _ExtentX        =   3519
            _ExtentY        =   556
            _Version        =   393216
            Format          =   305790977
            CurrentDate     =   39282
         End
         Begin VB.Label Label2 
            Caption         =   "開票日期"
            Height          =   255
            Index           =   0
            Left            =   4380
            TabIndex        =   6
            Top             =   360
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "發票編號"
            Height          =   255
            Left            =   360
            TabIndex        =   5
            Top             =   360
            Width           =   1035
         End
      End
   End
End
Attribute VB_Name = "frmShipmentsInvoiceInfo"
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 Integer

Private Sub ActiveBar21_ComboSelChange(ByVal Tool As ActiveBar2LibraryCtl.Tool)
  If Tool.CBListIndex = 0 Then
        txtRemarks.Enabled = True
    Else
        txtRemarks.Enabled = False
    End If
End Sub

Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Select Case Tool.Name
            Case "cmdSave":
                 Save newItem
           Case "cmdCancel":
                Unload Me
            Case "cmdDel":
                DelOperatorInf
            Case "cmdPrint"
                If ActiveBar21.Bands("toolbar").Tools.item("cmdSelectInvoice").CBListIndex = 1 Then
                   Call PrintInvoice
                Else
                   Call PrintInvoiceClassA
                End If
    End Select
End Sub
Private Sub PrintInvoice()
   With BillReportInvoice
        .CustomerName.SetText txtCustomer
        .Linkman.SetText txtLinkman
        .InvoiceNo.SetText txtInvoiceNo
        .FoundDate.SetText FoundDate.Value
        .Payment.SetText txtPayment
        .RepDelivery.SetText Delivery.Value
        .Payment.SetText txtPayment
        .RepTotalAmount.SetText MSHF1.TextMatrix(1, 3)
        .CharAmount.SetText MSHF1.TextMatrix(1, 6)
        .CurrencyName.SetText txtCurrencyName
   End With
   Dim i, iRows As Integer
   Dim rs As ADODB.Recordset
   Dim rsobj As ADODB.Recordset
  Set rs = New ADODB.Recordset
  Set rsobj = New ADODB.Recordset
  rsobj.Open "select * from tBasicProduct where FabricCode='" & txtFabricNo & "'", Cn, 1, 3
  With rs
      .LockType = adLockOptimistic
      .CursorType = adOpenDynamic
  End With
  rs.Fields.Append "ContractNo", adVarChar, 20
  rs.Fields.Append "Composition", adVarChar, 50
  rs.Fields.Append "Construstion", adVarChar, 100
  rs.Fields.Append "YarnCount", adVarChar, 20
  rs.Fields.Append "tWidth", adVarChar, 20
  rs.Fields.Append "Remark", adVarChar, 100
  rs.Fields.Append "eLayoutColor", adVarChar, 20
  rs.Fields.Append "InvoicesAmount", adVarChar, 20
  rs.Fields.Append "InvoicesPrice", adVarChar, 20
  rs.Fields.Append "Amount", adVarChar, 20
  rs.Fields.Append "ShipmentsPattern", adVarChar, 20
  rs.Fields.Append "Ex1", adVarChar, 20
  rs.Open
  With Me.MSHF1
       iRows = .Rows - 2
       For i = 2 To iRows + 1
            rs.AddNew
            rs.Fields!ContractNo = MSHF1.TextMatrix(i, 1)
            rs.Fields!Composition = NullValue(rsobj.Fields!Composition)
            rs.Fields!Construstion = NullValue(rsobj.Fields!Construstion)
            rs.Fields!YarnCount = NullValue(rsobj.Fields!YarnCount)
            rs.Fields!tWidth = NullValue(rsobj.Fields!Width)
            rs.Fields!Remark = NullValue(rsobj.Fields!Remarks)
            rs.Fields!eLayoutColor = MSHF1.TextMatrix(i, 2)
            rs.Fields!InvoicesAmount = MSHF1.TextMatrix(i, 3)
            rs.Fields!InvoicesPrice = MSHF1.TextMatrix(i, 4)
            rs.Fields!Amount = MSHF1.TextMatrix(i, 6)
            rs.Fields!ShipmentsPattern = MSHF1.TextMatrix(i, 7)
            rs.Fields!Ex1 = MSHF1.TextMatrix(i, 8)
            rs.Update
        Next
  End With
    BillReportInvoice.dataBase.SetDataSource rs
    rs.Close
    rsobj.Close
    Set rsobj = Nothing
    Set rs = Nothing
    frmReportInvoice.Show vbModal
End Sub
Private Sub PrintInvoiceClassA()
 Dim rso As ADODB.Recordset
 Set rso = New ADODB.Recordset
 rso.Open "select * from tCustomer where CustomerNo ='" & txtCustomerNo & "'", Cn, 1, 3
 If rso.EOF Then
    MsgBox "無打印信息", vbInformation + vbOKOnly, "提示"
    Exit Sub
 End If
   With BillReportInvoiceClassA
        .CustomerAllName.SetText rso.Fields!CustomerAllName
        .Address.SetText rso.Fields!Address
        .InvoiceNo.SetText txtInvoiceNo
        .FoundDate.SetText FoundDate
   End With
   rso.Close
   rso.Open "select Remarks from tShipmentsInvoice where InvoiceNo='" & txtInvoiceNo & "'"
   Dim i, iRows As Integer
   Dim rs As ADODB.Recordset
   Dim rsobj As ADODB.Recordset
  Set rs = New ADODB.Recordset
  Set rsobj = New ADODB.Recordset
  rsobj.Open "select * from tBasicProduct where FabricCode='" & txtFabricNo & "'", Cn, 1, 3
  If rsobj.EOF Then
     MsgBox "無布種信息可打印", vbInformation + vbOKOnly, "提示"
     Exit Sub
  End If
  With rs
      .LockType = adLockOptimistic
      .CursorType = adOpenDynamic
  End With
  rs.Fields.Append "Composition", adVarChar, 100
  rs.Fields.Append "FabricName", adVarChar, 20
  rs.Fields.Append "FabricNo", adVarChar, 20
  rs.Fields.Append "remarks", adVarChar, 100
  rs.Fields.Append "tWidth", adVarChar, 20
  rs.Fields.Append "Construstion", adVarChar, 50
  rs.Fields.Append "YarnCount", adVarChar, 20
  rs.Fields.Append "ShipmentsPatternAmount", adVarChar, 20
  rs.Fields.Append "ShipmentsPatternNo", adVarChar, 20
  rs.Fields.Append "Price", adVarChar, 20
  rs.Fields.Append "Total", adVarChar, 20
  rs.Fields.Append "Quantity", adVarChar, 20
  rs.Fields.Append "eLayoutColor", adVarChar, 20
  rs.Fields.Append "Ex1", adVarChar, 20
  rs.Fields.Append "Ex2", adBSTR
  rs.Open
  With Me.MSHF1
       iRows = .Rows - 2
       For i = 2 To iRows + 1
            rs.AddNew
            rs.Fields!Composition = NullValue(rsobj.Fields!Composition)
            rs.Fields!FabricName = NullValue(rsobj.Fields!FabricName)
            rs.Fields!FabricNo = NullValue(rsobj.Fields!FabricCode)
            rs.Fields!Remarks = NullValue(rsobj.Fields!Remarks)
            rs.Fields!tWidth = NullValue(rsobj.Fields!Width)
            rs.Fields!Construstion = NullValue(rsobj.Fields!Construstion)
            rs.Fields!YarnCount = NullValue(rs.Fields!YarnCount)
            rs.Fields!ShipmentsPatternAmount = MSHF1.TextMatrix(i, 8)
            rs.Fields!ShipmentsPatternNo = MSHF1.TextMatrix(i, 7)
            rs.Fields!Price = MSHF1.TextMatrix(i, 4)
            rs.Fields!Total = MSHF1.TextMatrix(i, 9)
            rs.Fields!Quantity = MSHF1.TextMatrix(i, 3)
            rs.Fields!eLayoutColor = MSHF1.TextMatrix(i, 2)
            rs.Fields!Ex1 = MSHF1.TextMatrix(i, 10)
            rs.Fields!Ex2 = NullValue(rso.Fields!Remarks)
            rs.Update
        Next
  End With
    BillReportInvoiceClassA.dataBase.SetDataSource rs
    rs.Close
    rso.Close
    rsobj.Close
    Set rso = Nothing
    Set rsobj = Nothing
    Set rs = Nothing
    
   frmReportShipmentsInvoiceA.Show vbModal
   End Sub
Private Sub CmdMakeNoticesNo_Click()
    frnPic.Visible = True
    txtDate = Right(Year(Now) & IIf(Month(Now) >= 10, Month(Now), "0" & Month(Now)), 3)
    Dim rs As New ADODB.Recordset
    rs.Open "select id from tShipmentsInvoice where invoiceNo like '" & txtHead & "%'", Cn, 1, 3
    If rs.EOF Or rs.BOF Then
       txtNoticesId = "0001"
       Exit Sub
    End If
    rs.MoveLast
    txtNoticesId = String(4 - Len(rs.Fields!ID + 1), "0") & rs.Fields!ID + 1
    rs.Close
    Set rs = Nothing
End Sub

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

Private Sub CmdNoticesOk_Click()
   txtInvoiceNo = txtHead & "-" & txtDate & "-" & txtNum & "-" & txtNoticesId
   frnPic.Visible = False
End Sub

Private Sub cmdOk_Click()
    frmShipmentsInvoiceSelect.Show vbModal
End Sub