📄 frmproductsae.frm
字号:
End If
'check for blank category
If Trim(dcCategory.Text) = "" Then
MsgBox "Category should not be empty.", vbExclamation
Exit Sub
End If
'check for blank unit measures
If cIRowCount < 1 Then
MsgBox "Please provide at least one product measure.", vbExclamation
Exit Sub
End If
CN.BeginTrans
If State = adStateAddMode Or State = adStatePopupMode Then
RS.AddNew
RS.Fields("StockId") = PK
RS.Fields("addedbyfk") = CurrUser.USER_PK
Else
RS.Fields("datemodified") = Now
RS.Fields("lastuserfk") = CurrUser.USER_PK
End If
With RS
.Fields("Barcode") = txtEntry(1).Text
.Fields("Stock") = txtEntry(2).Text
.Fields("Short") = txtEntry(3).Text
.Fields("ICode") = txtEntry(4).Text
.Fields("ReorderPoint") = toNumber(txtEntry(5).Text)
.Fields("ExtPrice") = toMoney(txtEntry(6).Text)
.Fields("UnitID") = dcReoderUnit.BoundText
.Fields("Status") = cboStatus.Text
.Fields("CategoryID") = dcCategory.BoundText
.Update
End With
Dim RSStockUnit As New Recordset
RSStockUnit.CursorLocation = adUseClient
RSStockUnit.Open "SELECT * FROM Stock_Unit WHERE StockID=" & PK, CN, adOpenStatic, adLockOptimistic
DeleteItems
Dim c As Integer
With Grid
'Save the details of the records
For c = 1 To cIRowCount
.Row = c
If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
'Add qty received in Local Purchase Details
RSStockUnit.AddNew
RSStockUnit![StockID] = PK
RSStockUnit![Order] = toNumber(.TextMatrix(c, 1))
RSStockUnit![UnitID] = toNumber(.TextMatrix(c, 9))
RSStockUnit![Qty] = toNumber(.TextMatrix(c, 2))
RSStockUnit![SalesPrice] = toNumber(.TextMatrix(c, 4))
RSStockUnit![SupplierPrice] = toNumber(.TextMatrix(c, 5))
RSStockUnit![Pending] = toNumber(.TextMatrix(c, 6))
RSStockUnit![Incoming] = toNumber(.TextMatrix(c, 7))
RSStockUnit![Onhand] = toNumber(.TextMatrix(c, 8))
RSStockUnit.Update
ElseIf State = adStateEditMode Then
RSStockUnit.Filter = "UnitID = " & toNumber(.TextMatrix(c, 9))
If RSStockUnit.RecordCount = 0 Then GoTo AddNew
RSStockUnit![Order] = toNumber(.TextMatrix(c, 1))
RSStockUnit![UnitID] = toNumber(.TextMatrix(c, 9))
RSStockUnit![Qty] = toNumber(.TextMatrix(c, 2))
RSStockUnit![SalesPrice] = toNumber(.TextMatrix(c, 4))
RSStockUnit![SupplierPrice] = toNumber(.TextMatrix(c, 5))
RSStockUnit![Pending] = toNumber(.TextMatrix(c, 6))
RSStockUnit![Incoming] = toNumber(.TextMatrix(c, 7))
RSStockUnit![Onhand] = toNumber(.TextMatrix(c, 8))
RSStockUnit.Update
End If
Next c
End With
'Clear variables
c = 0
Set RSStockUnit = Nothing
CN.CommitTrans
HaveAction = True
If State = adStateAddMode Then
MsgBox "New record has been successfully saved.", vbInformation
If MsgBox("Do you want to add another new record?", vbQuestion + vbYesNo) = vbYes Then
ResetFields
Else
Unload Me
End If
ElseIf State = adStatePopupMode Then
MsgBox "New record has been successfully saved.", vbInformation
Unload Me
Else
MsgBox "Changes in record has been successfully saved.", vbInformation
Unload Me
End If
Exit Sub
err:
If err.Number = -2147217887 Then
Resume Next
Else
CN.RollbackTrans
prompt_err err, Name, "cmdSave_Click"
Screen.MousePointer = vbDefault
End If
End Sub
Private Sub cmdUsrHistory_Click()
On Error Resume Next
Dim tDate1 As String
Dim tDate2 As String
Dim tUser1 As String
Dim tUser2 As String
tDate1 = Format$(RS.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
tDate2 = Format$(RS.Fields("DateModified"), "MMM-dd-yyyy HH:MM AMPM")
tUser1 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & RS.Fields("AddedByFK"), "CompleteName")
tUser2 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & RS.Fields("LastUserFK"), "CompleteName")
MsgBox "Date Added: " & tDate1 & vbCrLf & _
"Added By: " & tUser1 & vbCrLf & _
"" & vbCrLf & _
"Last Modified: " & tDate2 & vbCrLf & _
"Modified By: " & tUser2, vbInformation, "Modification History"
tDate1 = vbNullString
tDate2 = vbNullString
tUser1 = vbNullString
tUser2 = vbNullString
End Sub
'Procedure used to generate PK
Private Sub GeneratePK()
PK = getIndex("Stock")
End Sub
Private Sub Form_Load()
InitGrid
InitNSD
RS.CursorLocation = adUseClient
RS.Open "SELECT * FROM Stocks WHERE StockID = " & PK, CN, adOpenStatic, adLockOptimistic
rs1.CursorLocation = adUseClient
rs1.Open "SELECT * FROM qry_Stock_Unit WHERE StockID = " & PK, CN, adOpenStatic, adLockOptimistic
bind_dc "SELECT * FROM Stocks_Category order by category asc", "Category", dcCategory, "CategoryID", True
bind_dc "SELECT * FROM Unit order by unit asc", "Unit", dcReoderUnit, "UnitID", True
'Check the form state
If State = adStateAddMode Or State = adStatePopupMode Then
Caption = "Create New Entry"
cmdUsrHistory.Enabled = False
dcCategory.Text = ""
GeneratePK
Else
Caption = "Edit Entry"
DisplayForEditing
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If HaveAction = True Then
If State = adStateAddMode Or State = adStateEditMode Then
frmProducts.RefreshRecords
ElseIf State = adStatePopupMode Then
srcText.Text = txtEntry(1).Text
srcText.Tag = PK
On Error Resume Next
srcTextAdd.Text = RS![DisplayAddr]
srcTextCP.Text = txtEntry(6).Text
'srcTextDisc.Text = toNumber(cmdDisc.Text)
End If
End If
Set frmProductsAE = Nothing
End Sub
Private Sub Grid_Click()
With Grid
txtOrder.Text = .TextMatrix(.RowSel, 1)
txtQty.Text = .TextMatrix(.RowSel, 2)
nsdUnit.Text = .TextMatrix(.RowSel, 3)
nsdUnit.Tag = .TextMatrix(.RowSel, 9) 'Add tag coz boundtext is empty
txtSalesPrice.Text = .TextMatrix(.RowSel, 4)
txtSupplierPrice.Text = .TextMatrix(.RowSel, 5)
txtPending.Text = .TextMatrix(.RowSel, 6)
txtIncoming.Text = .TextMatrix(.RowSel, 7)
txtOnHand.Text = .TextMatrix(.RowSel, 8)
If Grid.Rows = 2 And Grid.TextMatrix(1, 9) = "" Then '10 = StockID
btnRemove.Visible = False
Else
btnRemove.Visible = True
btnRemove.Top = (Grid.CellTop + Grid.Top) - 20
btnRemove.Left = Grid.Left + 50
End If
End With
End Sub
Private Sub lvPriceHistory_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With lvPriceHistory
'MsgBox .ColumnHeaders(2).Width & vbCr _
& .ColumnHeaders(3).Width & vbCr _
& .ColumnHeaders(4).Width
End With
End Sub
Private Sub nsdUnit_Change()
nsdUnit.Tag = nsdUnit.BoundText
End Sub
Private Sub txtEntry_GotFocus(Index As Integer)
If Index = 8 Then cmdSave.Default = False
HLText txtEntry(Index)
End Sub
Private Sub txtEntry_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 9 Or Index = 10 Then KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtEntry_LostFocus(Index As Integer)
If Index = 8 Then cmdSave.Default = True
End Sub
'Procedure used to initialize the grid
Private Sub InitGrid()
cIRowCount = 0
With Grid
.Clear
.ClearStructure
.Rows = 2
.FixedRows = 1
.FixedCols = 1
.Cols = 10
.ColSel = 9
'Initialize the column size
.ColWidth(0) = 315
.ColWidth(1) = 800
.ColWidth(2) = 800
.ColWidth(3) = 800
.ColWidth(4) = 900
.ColWidth(5) = 1200
.ColWidth(6) = 1200
.ColWidth(7) = 1200
.ColWidth(8) = 900
.ColWidth(9) = 0
'Initialize the column name
.TextMatrix(0, 0) = ""
.TextMatrix(0, 1) = "Order"
.TextMatrix(0, 2) = "Qty"
.TextMatrix(0, 3) = "Unit"
.TextMatrix(0, 4) = "Sales Price"
.TextMatrix(0, 5) = "Supplier Price"
.TextMatrix(0, 6) = "Pending"
.TextMatrix(0, 7) = "Incoming"
.TextMatrix(0, 8) = "On Hand"
.TextMatrix(0, 9) = "Unit ID"
'Set the column alignment
' .ColAlignment(0) = vbLeftJustify
' .ColAlignment(1) = vbLeftJustify
' .ColAlignment(2) = vbLeftJustify
' .ColAlignment(3) = flexAlignGeneral
' .ColAlignment(4) = flexAlignGeneral
' .ColAlignment(5) = vbRightJustify
' .ColAlignment(6) = vbRightJustify
' .ColAlignment(7) = vbRightJustify
' .ColAlignment(8) = vbRightJustify
End With
End Sub
Private Sub InitNSD()
'For Vendor
With nsdUnit
.ClearColumn
.AddColumn "Unit ID", 1794.89
.AddColumn "Unit", 2264.88
.Connection = CN.ConnectionString
'.sqlFields = "VendorID, Company, Location"
.sqlFields = "UnitID, Unit"
.sqlTables = "Unit"
.sqlSortOrder = "Unit ASC"
.BoundField = "UnitID"
.PageBy = 25
.DisplayCol = 2
.setDropWindowSize 7000, 4000
.TextReadOnly = True
.SetDropDownTitle = "Units Record"
End With
End Sub
Private Sub DeleteItems()
Dim CurrRow As Integer
Dim rsUnit As New Recordset
If State = adStateAddMode Then Exit Sub
rsUnit.CursorLocation = adUseClient
rsUnit.Open "SELECT * FROM Stock_Unit WHERE StockID=" & PK, CN, adOpenStatic, adLockOptimistic
If rsUnit.RecordCount > 0 Then
rsUnit.MoveFirst
While Not rsUnit.EOF
CurrRow = getFlexPos(Grid, 9, rsUnit!UnitID)
'Add to grid
With Grid
If CurrRow < 0 Then
'Delete record if doesnt exist in flexgrid
DelRecwSQL "Stock_Unit", "StockUnitID", "", True, rsUnit!StockUnitID
End If
End With
rsUnit.MoveNext
Wend
End If
End Sub
Private Sub txtIncoming_GotFocus()
HLText txtIncoming
End Sub
Private Sub txtIncoming_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtIncoming_Validate(Cancel As Boolean)
txtIncoming.Text = toNumber(txtIncoming.Text)
End Sub
Private Sub txtOnHand_GotFocus()
HLText txtOnHand
End Sub
Private Sub txtOnHand_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtOnHand_Validate(Cancel As Boolean)
txtOnHand.Text = toNumber(txtOnHand.Text)
End Sub
Private Sub txtOrder_GotFocus()
HLText txtOrder
End Sub
Private Sub txtOrder_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtPending_GotFocus()
HLText txtPending
End Sub
Private Sub txtPending_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtPending_Validate(Cancel As Boolean)
txtPending.Text = toNumber(txtPending.Text)
End Sub
Private Sub txtQty_GotFocus()
HLText txtQty
End Sub
Private Sub txtQty_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtSalesPrice_GotFocus()
HLText txtSalesPrice
End Sub
Private Sub txtSalesPrice_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtSalesPrice_Validate(Cancel As Boolean)
txtSalesPrice.Text = toMoney(toNumber(txtSalesPrice.Text))
End Sub
Private Sub txtSupplierPrice_GotFocus()
HLText txtSupplierPrice
End Sub
Private Sub txtSupplierPrice_KeyPress(KeyAscii As Integer)
KeyAscii = isNumber(KeyAscii)
End Sub
Private Sub txtSupplierPrice_Validate(Cancel As Boolean)
txtSupplierPrice.Text = toMoney(toNumber(txtSupplierPrice.Text))
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -