frmshipmentsinvoiceinfo.frm

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

Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    If newItem = False Then
       CmdMakeNoticesNo.Enabled = False
       cmdOK.Enabled = False
    End If
    txtHead.AddItem ("IN")
    txtHead.AddItem ("JJ")
    txtHead.AddItem ("WI")
    ActiveBar21.Bands("toolbar").Tools.item("cmdSelectInvoice").CBAddItem ("發票A")
    ActiveBar21.Bands("toolbar").Tools.item("cmdSelectInvoice").CBAddItem ("發票B")
    InitTitle
End Sub
Private Sub InitTitle()
    Label1.Caption = "發票編號"
    Label2.item(0).Caption = "開票日期"
    Label2.item(1).Caption = "客戶編號"
    Label3.Caption = "幣種"
    Label15.Caption = "原產地"
    Label14.Caption = "交期"
    Label13.Caption = "付款方式"
    Label8.Caption = "布號"
    Label9.Caption = "布名"
    Label11.Caption = "組織"
   ' Label17.Caption = "顏色花型"
    Label6 = "聯繫人"
    Label10.Caption = "填寫人"
    Frame4.Caption = "備註"
    CmdNoticesOk.Caption = "確定"
    CmdNoticesCancel.Caption = "取消"
    Me.Caption = "出貨發票明細"
End Sub
Private Sub DelOperatorInf()
    Dim strSql As String
    On Error GoTo errHandle
    If txtInvoiceNo = "" Then
       MsgBox "沒有可刪除的記錄", vbCritical + vbOKOnly, "提示"
       Exit Sub
    End If
    If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
        Exit Sub
    Else
        strSql = "delete from  tShipmentsInvoice where id=" & txtId
        objDatabase.ExecCmd strSql
        MsgBox "刪除成功!", vbInformation, "提示"
    End If
        frmShipmentsTodo.FillMshf1 ("select * from vShipmentsInvoices")
    Unload Me
    Exit Sub
errHandle:
   objDatabase.DatabaseError
    
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 vShipmentsInvoicesInfo where InvoiceNo='" & strId & "'"
        rs.Open strSql
        If Not rs.EOF Then
            txtInvoiceNo = NullValue(rs.Fields!InvoiceNo)
            txtCustomerNo = NullValue(rs.Fields!CustomerNo)
            txtCustomer = NullValue(rs.Fields!CustomerName)
            txtLinkman = NullValue(rs.Fields!Linkman)
            txtCurrencyName = NullValue(rs.Fields!CurrencyName)
            txtPayment = NullValue(rs.Fields!Payment)
            Delivery = NullValue(rs.Fields!Delivery)
            txtId = NullValue(rs.Fields!ID)
        End If
        rs.Close
      Set rs = Nothing
      ReadOrderInfo "select * from vShipmentsInvoicesInfo where InvoiceNo='" & txtInvoiceNo & "'"
      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 txtInvoiceNo = "" Then
            MsgBox "請填寫發票編號", vbCritical, "提示"
            txtInvoiceNo.SetFocus
            Exit Sub
        End If
        If blModi Then
        strSql = "select * from tShipmentsInvoice"
        rs.Open strSql
            If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
                    
            rs.AddNew '新建
        Else
            strSql = "select * from tShipmentsInvoice where InvoiceNo='" & txtInvoiceNo & "'"
            rs.Open strSql
            If rs.EOF Then '修改
                MsgBox "没有可修改的信息!", vbExclamation, "修改"
                rs.Close
                Set rs = Nothing
                txtInvoiceNo.SetFocus
                Exit Sub
            End If
            If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
        rs.Fields!InvoiceNo = txtInvoiceNo
        rs.Fields!FoundDate = FoundDate
        rs.Fields!CustomerNo = txtCustomerNo
        rs.Fields!Customer = txtCustomer
        rs.Fields!Linkman = txtLinkman
        rs.Fields!CurrencyName = txtCurrencyName
        rs.Fields!Amount = MSHF1.TextMatrix(1, 3)
        rs.Fields!AmountCn = MSHF1.TextMatrix(1, 5)
        rs.Fields!unit = txtUnit
        rs.Fields!Payment = txtPayment
        rs.Fields!Delivery = Delivery
        rs.Fields!Origin = txtOrigin
        rs.Fields!Remarks = txtRemarks
        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 InvoiceNo='" & txtInvoiceNo & "' where ContractNo='" & MSHF1.TextMatrix(lngrow, 1) & "'")
        Next lngrow
        lngrow = 0
        frmShipmentsInvoice.FillMshf1 ("select * from vShipmentsInvoices")
        Unload Me
        Exit Sub
errHandle:
    Set rs = Nothing
    objDatabase.DatabaseError
End Sub
Public Sub ReadOrderInfo(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
      With MSHF1
          .Redraw = False
          .Rows = 2
          .Cols = 11
          .Clear
          '初始化
         .WordWrap = False
         .TextMatrix(0, 0) = "序号"
         .ColWidth(0) = 600
         .TextMatrix(0, 1) = "合約編號"
         .ColWidth(1) = 1500
         .TextMatrix(0, 2) = "顏色花型"
         .ColWidth(2) = 1500
         .TextMatrix(0, 3) = "出貨數量"
         .ColWidth(3) = 1200
         .TextMatrix(0, 4) = "單價"
         .ColWidth(4) = 1200
         .TextMatrix(0, 5) = "價錢單位"
         .ColWidth(5) = 1000
         .TextMatrix(0, 6) = "合計金額"
         .ColWidth(6) = 2000
         .TextMatrix(0, 7) = ""
         .ColWidth(7) = 0
         .TextMatrix(0, 8) = ""
         .ColWidth(8) = 0
         .TextMatrix(0, 9) = ""
         .ColWidth(9) = 0
         .TextMatrix(0, 10) = ""
         .ColWidth(10) = 0
        '.....................................................
         .Rows = rs.RecordCount + 2
         'On Error Resume Next
         Dim i, SumMoney As Integer
         Dim CharMoney As String
         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!eLayoutColor)
                .TextMatrix(lngrow, 3) = NullValue(rs.Fields!InvoiceQuantity)
                .TextMatrix(lngrow, 5) = NullValue(rs.Fields!unit)
                .TextMatrix(lngrow, 4) = NullValue(rs.Fields!Price)
                .TextMatrix(lngrow, 6) = CInt(rs.Fields!Price) * CInt(rs.Fields!InvoiceQuantity)
                .TextMatrix(lngrow, 7) = NullValue(rs.Fields!ShipmentsPatternNo)
                .TextMatrix(lngrow, 8) = NullValue(rs.Fields!ShipmentsPatternAmount)
                .TextMatrix(lngrow, 9) = CInt(rs.Fields!InvoiceQuantity) + CInt(rs.Fields!ShipmentsPatternAmount)
                .TextMatrix(lngrow, 10) = CInt(rs.Fields!Price) * (CInt(rs.Fields!InvoiceQuantity) + CInt(rs.Fields!ShipmentsPatternAmount))
                SumMoney = SumMoney + CInt(rs.Fields!Price) * CInt(rs.Fields!InvoiceQuantity)
                CharMoney = AlphaNumber(SumMoney)
                rs.MoveNext
          Next
          lngrow = 0
          .TextMatrix(1, 0) = "总计"
          .TextMatrix(1, 1) = .Rows - 2
          .TextMatrix(1, 2) = "總計金額"
          .TextMatrix(1, 3) = SumMoney
          .TextMatrix(1, 5) = "大寫"
          .TextMatrix(1, 6) = CharMoney
           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
Private Sub txtAmount_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub MSHF1_Click()
    lngrow = Val(MSHF1.row)
    If lngrow = 1 Then
       MSHF1.Sort = 1
    Else
       MSHF1.row = lngrow
        MSHF1.col = 0
        MSHF1.ColSel = MSHF1.Cols - 1
    End If
End Sub
Private Sub MSHF1_DblClick()
    If lngrow = 1 Then
       MsgBox "請選擇記錄!", vbInformation + vbOKOnly, "提示"
       Exit Sub
    End If
    With frmShipmentsInvoiceSub
    .txtContractNo = MSHF1.TextMatrix(lngrow, 1)
    .txtLayoutColor = MSHF1.TextMatrix(lngrow, 2)
    .txtQuantity = MSHF1.TextMatrix(lngrow, 3)
    .txtPrice = MSHF1.TextMatrix(lngrow, 4)
    .txtInvoiceNo = txtInvoiceNo
    .lngrow = lngrow
    .newItem = newItem
    End With
    frmShipmentsInvoiceSub.Show vbModal
End Sub
Private Sub txtHead_Click()
    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 txtInvoicePrice_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> 46 Then
            If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
 End If
End Sub

Private Sub txtNoticesId_Change()
   If Len(txtNoticesId) > 4 Then
      MsgBox "只能輸入4位", vbInformation + vbOKOnly, "提示"
      txtNoticesId = Left(txtNoticesId, 4)
      txtNoticesId.SetFocus
      Exit Sub
   End If
End Sub

Private Sub txtNum_Change()
   If Len(txtNum) > 1 Then
      MsgBox "只能輸入1位", vbInformation + vbOKOnly, "提示"
      txtNum = Left(txtNum, 1)
      txtNum.SetFocus
      Exit Sub
   End If
End Sub