📄 frmvancollectionae.frm
字号:
Height = 315
Left = 7875
TabIndex = 3
Top = 75
Width = 3105
_ExtentX = 5477
_ExtentY = 556
_Version = 393216
Style = 2
BackColor = -2147483643
ForeColor = -2147483640
Text = ""
End
Begin InvtySystem.ctrlLiner ctrlLiner3
Height = 30
Left = 225
TabIndex = 39
Top = 900
Width = 10740
_ExtentX = 18944
_ExtentY = 53
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Van"
Height = 240
Index = 7
Left = 6600
TabIndex = 37
Top = 75
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Remarks"
Height = 240
Index = 4
Left = -150
TabIndex = 32
Top = 5550
Width = 990
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "Total Collection"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000011D&
Height = 240
Left = 7350
TabIndex = 30
Top = 5550
Width = 2040
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Salesman"
Height = 240
Index = 18
Left = 6600
TabIndex = 26
Top = 450
Width = 1215
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "Current Collection"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000014&
Height = 210
Left = 300
TabIndex = 25
Top = 2925
Width = 4365
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Date"
Height = 240
Index = 1
Left = 150
TabIndex = 24
Top = 525
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Collection No"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 150
TabIndex = 23
Top = 150
Width = 1215
End
Begin VB.Shape Shape3
BackColor = &H80000010&
BackStyle = 1 'Opaque
BorderColor = &H80000010&
Height = 240
Left = 225
Top = 2925
Width = 10740
End
End
Attribute VB_Name = "frmVanCollectionAE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public State As FormState 'Variable used to determine on how the form used
Public PK As Long 'Variable used to get what record is going to edit
Public LLFK As Long 'Last loading FK
Public CloseMe As Boolean
Dim cCAmount As Currency 'Current Collection Amount
Dim cCRowCount As Integer
Dim HaveAction As Boolean 'Variable used to detect if the user perform some action
Dim rs As New Recordset 'Main recordset for Invoice
Private Sub btnCollect_Click()
If toNumber(txtPayment.Text) < 0 Then
MsgBox "Please enter a valid payment.", vbExclamation
txtPayment.SetFocus
Exit Sub
End If
Dim CurrRow As Integer
If chkOldInv.Value = 1 Then
CurrRow = getFlexPos(Grid, 8, nsdInvoice.BoundText)
Else
CurrRow = -1
End If
'Add to grid
With Grid
If CurrRow < 0 Then
'Perform if the record is not exist
If .Rows = 2 And .TextMatrix(1, 8) = "" And .TextMatrix(1, 5) = "" Then
.TextMatrix(1, 1) = Format$(dtColDate.Value, "MMM-dd-yyyy")
If chkOldInv.Value = 1 Then
.TextMatrix(1, 2) = nsdInvoice.Text
.TextMatrix(1, 8) = nsdInvoice.BoundText
Else
.TextMatrix(1, 2) = txtInv.Text
End If
.TextMatrix(1, 3) = txtCusAdd.Text
.TextMatrix(1, 4) = cbPT.Text
.TextMatrix(1, 5) = txtPayment.Text
.TextMatrix(1, 6) = txtBal.Text
.TextMatrix(1, 7) = txtRem.Text
Else
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 1) = Format$(dtColDate.Value, "MMM-dd-yyyy")
If chkOldInv.Value = 1 Then
.TextMatrix(.Rows - 1, 2) = nsdInvoice.Text
.TextMatrix(.Rows - 1, 8) = nsdInvoice.BoundText
Else
.TextMatrix(.Rows - 1, 2) = txtInv.Text
End If
.TextMatrix(.Rows - 1, 3) = txtCusAdd.Text
.TextMatrix(.Rows - 1, 4) = cbPT.Text
.TextMatrix(.Rows - 1, 5) = txtPayment.Text
.TextMatrix(.Rows - 1, 6) = txtBal.Text
.TextMatrix(.Rows - 1, 7) = txtRem.Text
.Row = .Rows - 1
End If
'Increase the record count
cCRowCount = cCRowCount + 1
Else
If MsgBox("Invoice payment already exist.Do you want to replace it?", vbQuestion + vbYesNo) = vbYes Then
.Row = CurrRow
'Restore back the collected amount
cCAmount = cCAmount - toNumber(Grid.TextMatrix(.RowSel, 5))
txtTA.Text = toMoney(cCAmount)
'Replace collection
.TextMatrix(CurrRow, 1) = Format$(dtColDate.Value, "MMM-dd-yyyy")
If chkOldInv.Value = 1 Then
.TextMatrix(CurrRow, 2) = nsdInvoice.Text
.TextMatrix(CurrRow, 8) = nsdInvoice.BoundText
Else
.TextMatrix(CurrRow, 2) = txtInv.Text
End If
.TextMatrix(CurrRow, 3) = txtCusAdd.Text
.TextMatrix(CurrRow, 4) = cbPT.Text
.TextMatrix(CurrRow, 5) = txtPayment.Text
.TextMatrix(CurrRow, 6) = txtBal.Text
.TextMatrix(CurrRow, 7) = txtRem.Text
Else
Exit Sub
End If
End If
'Add the amount to current load amount
cCAmount = cCAmount + toNumber(txtPayment.Text)
txtTA.Text = toMoney(cCAmount)
'Highlight the current row's column
.ColSel = 8
'Display a remove button
Grid_Click
'Reset the entry fields
ResetEntry
End With
End Sub
Private Sub btnRemove_Click()
'Remove selected load product
With Grid
'Update amount to current collection amount
cCAmount = cCAmount - toNumber(Grid.TextMatrix(.RowSel, 5))
txtTA.Text = toMoney(cCAmount)
'Update the record count
cCRowCount = cCRowCount - 1
If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
.RemoveItem (.RowSel)
End With
btnRemove.Visible = False
Grid_Click
End Sub
Private Sub chkOldInv_Click()
If chkOldInv.Value = 1 Then
txtInv.Visible = False
nsdInvoice.Visible = True
txtCusAdd.Visible = True
txtBal.Visible = True
Labels(5).Visible = True
Labels(6).Visible = True
txtPayment.Enabled = False
btnCollect.Enabled = False
Else
txtInv.Visible = True
nsdInvoice.Visible = False
txtCusAdd.Visible = False
txtBal.Visible = False
Labels(5).Visible = False
Labels(6).Visible = False
txtPayment.Enabled = True
btnCollect.Enabled = True
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
'Verify the entries
If dcSalesman.BoundText = "" Then
MsgBox "Please select a salesman in the list.", vbExclamation
dcSalesman.SetFocus
Exit Sub
End If
If dcVan.BoundText = "" Then
MsgBox "Please select a van in the list.", vbExclamation
dcVan.SetFocus
Exit Sub
End If
If cCRowCount < 1 Then
MsgBox "Please enter a collection first before you can save this record.", vbExclamation
nsdInvoice.SetFocus
Exit Sub
End If
If MsgBox("This save the record.Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Dim RSDetails As New Recordset
Dim iAM As Double 'Invoice Amount Paid
RSDetails.CursorLocation = adUseClient
RSDetails.Open "SELECT * FROM tbl_AR_PaymentHistory WHERE VCFK=" & PK, CN, adOpenStatic, adLockOptimistic
Screen.MousePointer = vbHourglass
Dim c As Integer
On Error GoTo err
CN.BeginTrans
'Save the record
With rs
If State = adStateAddMode Or State = adStatePopupMode Then
.AddNew
![PK] = PK
![DateAdded] = Now
![AddedByFK] = CurrUser.USER_PK
Else
![DateModified] = Now
![LastUserFK] = CurrUser.USER_PK
End If
![CollectionNo] = txtEntry(0).Text
![Date] = dtpDate.Value
![VanFK] = dcVan.BoundText
![SalesmanFK] = dcSalesman.BoundText
![Remarks] = txtEntry(8).Text
![LLFK] = LLFK
.Update
End With
With Grid
'Save the details of the records
For c = 1 To cCRowCount
.Row = c
If State = adStateAddMode Or State = adStatePopupMode Then
'Check the payment type
If .TextMatrix(c, 4) = "Post Dated Check" Then
Screen.MousePointer = vbDefault
frmPDCManagerAE.State = adStatePopupMode
frmPDCManagerAE.txtEntry(6).Text = "Payment for Invoice No. " & .TextMatrix(c, 2) & "."
frmPDCManagerAE.txtEntry(3).Text = .TextMatrix(c, 5)
frmPDCManagerAE.show vbModal
Screen.MousePointer = vbHourglass
End If
RSDetails.AddNew
RSDetails![PK] = getIndex("tbl_AR_PaymentHistory")
RSDetails![Date] = CDate(.TextMatrix(c, 1))
RSDetails![PaymentType] = .TextMatrix(c, 4)
RSDetails![Amount] = toNumber(.TextMatrix(c, 5))
RSDetails![Balance] = toNumber(.TextMatrix(c, 6))
RSDetails![Remarks] = .TextMatrix(c, 7)
RSDetails![VCFK] = PK
If toNumber(.TextMatrix(c, 8)) <> 0 Then RSDetails![InvoiceFK] = toNumber(.TextMatrix(c, 8))
RSDetails.Update
If toNumber(.TextMatrix(c, 8)) <> 0 Then
'***************************************************
'1. Get the amount paid
'2. Add the Amount Paid with the current pay
'3. Update it
'4. Change the status
'***************************************************
'Paid invoice
iAM = toNumber(getValueAt("SELECT PK,AmountPaid FROM tbl_AR_Invoice WHERE PK=" & toNumber(.TextMatrix(c, 8)), "AmountPaid"))
iAM = iAM + toNumber(.TextMatrix(c, 5))
ChangeValue CN, "tbl_AR_Invoice", "AmountPaid", iAM, True, "WHERE PK=" & toNumber(.TextMatrix(c, 8))
If toNumber(.TextMatrix(c, 6)) <= 0 Then
ChangeValue CN, "tbl_AR_Invoice", "Paid", "Y", False, "WHERE PK=" & toNumber(.TextMatrix(c, 8))
End If
End If
End If
Next c
End With
'Clear variables
c = 0
iAM = 0
Set RSDetails = Nothing
CN.CommitTrans
HaveAction = True
Screen.MousePointer = vbDefault
If State = adStateAddMode Then
MsgBox "New record has been successfully saved.", vbInformation
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -