📄 tmp2.frm
字号:
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 285
Left = 9375
Locked = -1 'True
TabIndex = 20
Text = "0.00"
Top = 6825
Width = 1500
End
Begin VB.TextBox txtEntry
BackColor = &H00E6FFFF&
ForeColor = &H00000000&
Height = 285
Index = 0
Left = 1425
Locked = -1 'True
TabIndex = 0
TabStop = 0 'False
Top = 150
Width = 2490
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid Grid
Height = 2190
Left = 150
TabIndex = 19
Top = 4575
Width = 10755
_ExtentX = 18971
_ExtentY = 3863
_Version = 393216
Rows = 0
FixedRows = 0
FixedCols = 0
RowHeightMin = 275
ForeColorFixed = -2147483640
BackColorSel = 1091552
ForeColorSel = 16777215
BackColorBkg = -2147483643
GridColor = -2147483633
GridColorFixed = -2147483633
GridColorUnpopulated= -2147483633
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
_Band(0).GridLinesBand= 1
_Band(0).TextStyleBand= 0
_Band(0).TextStyleHeader= 0
End
Begin MSDataListLib.DataCombo dcVan
Height = 315
Left = 8400
TabIndex = 3
Top = 150
Width = 2505
_ExtentX = 4419
_ExtentY = 556
_Version = 393216
Style = 2
BackColor = -2147483643
ForeColor = -2147483640
Text = ""
End
Begin MSComCtl2.DTPicker dtpDate
Height = 285
Left = 1425
TabIndex = 1
Top = 525
Width = 2505
_ExtentX = 4419
_ExtentY = 503
_Version = 393216
CustomFormat = "MMM-dd-yyyy"
Format = 24510467
CurrentDate = 38207
End
Begin VB.TextBox txtDate
Height = 285
Left = 1425
Locked = -1 'True
TabIndex = 2
Top = 525
Visible = 0 'False
Width = 2475
End
Begin VB.Line Line2
BorderColor = &H80000014&
Index = 1
X1 = 150
X2 = 10875
Y1 = 4125
Y2 = 4125
End
Begin VB.Line Line1
BorderColor = &H80000010&
BorderWidth = 2
Index = 1
X1 = 150
X2 = 10875
Y1 = 4125
Y2 = 4125
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "Van Inventory"
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 = 225
TabIndex = 30
Top = 4275
Width = 4365
End
Begin VB.Label Label9
Alignment = 1 'Right Justify
Caption = " Load Amount"
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 = 7275
TabIndex = 29
Top = 6825
Width = 2040
End
Begin VB.Line Line2
BorderColor = &H80000014&
Index = 0
X1 = 150
X2 = 10875
Y1 = 900
Y2 = 900
End
Begin VB.Line Line1
BorderColor = &H80000010&
BorderWidth = 2
Index = 0
X1 = 150
X2 = 10875
Y1 = 900
Y2 = 900
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Van"
Height = 240
Index = 4
Left = 7125
TabIndex = 28
Top = 150
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Inventory Date"
Height = 240
Index = 1
Left = 150
TabIndex = 27
Top = 525
Width = 1215
End
Begin VB.Label Labels
Alignment = 1 'Right Justify
Caption = "Inventory No"
Height = 240
Index = 0
Left = 75
TabIndex = 14
Top = 150
Width = 1290
End
Begin VB.Shape Shape3
BackColor = &H80000010&
BackStyle = 1 'Opaque
BorderColor = &H80000010&
Height = 240
Left = 150
Top = 4275
Width = 10740
End
End
Attribute VB_Name = "TMP2"
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 PCase As Long 'Pieces per case
Dim PBox As Long 'Pieces per box
Dim clAmount As Currency 'Current Loading Amount
Dim clRowCount As Integer
Dim HaveAction As Boolean 'Variable used to detect if the user perform some action
Dim rs As New Recordset 'Main recordset for loading
Private Sub btnLoad_Click()
Dim CurrRow As Integer
CurrRow = getFlexPos(Grid, 11, dcProd.BoundText)
'Add to grid
With Grid
If CurrRow < 0 Then
'Perform if the record is not exist
If .Rows = 2 And .TextMatrix(1, 11) = "" Then
.TextMatrix(1, 1) = dcProd.Text
.TextMatrix(1, 2) = txtEntry(1).Text
.TextMatrix(1, 3) = txtUC.Text
.TextMatrix(1, 4) = txtEntry(2).Text
.TextMatrix(1, 5) = txtEntry(3).Text
.TextMatrix(1, 6) = txtEntry(4).Text
.TextMatrix(1, 7) = txtLQty.Text
.TextMatrix(1, 8) = txtVIQty.Text
.TextMatrix(1, 9) = txtQty.Text
.TextMatrix(1, 10) = txtAmount.Text
.TextMatrix(1, 11) = dcProd.BoundText
Else
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 1) = dcProd.Text
.TextMatrix(.Rows - 1, 2) = txtEntry(1).Text
.TextMatrix(.Rows - 1, 3) = txtUC.Text
.TextMatrix(.Rows - 1, 4) = txtEntry(2).Text
.TextMatrix(.Rows - 1, 5) = txtEntry(3).Text
.TextMatrix(.Rows - 1, 6) = txtEntry(4).Text
.TextMatrix(.Rows - 1, 7) = txtLQty.Text
.TextMatrix(.Rows - 1, 8) = txtVIQty.Text
.TextMatrix(.Rows - 1, 9) = txtQty.Text
.TextMatrix(.Rows - 1, 10) = txtAmount.Text
.TextMatrix(.Rows - 1, 11) = dcProd.BoundText
.Row = .Rows - 1
End If
'Increase the record count
clRowCount = clRowCount + 1
Else
'Perform if the record already exist
.Row = CurrRow
.TextMatrix(CurrRow, 1) = dcProd.Text
.TextMatrix(CurrRow, 2) = txtEntry(1).Text
.TextMatrix(CurrRow, 3) = txtUC.Text
.TextMatrix(CurrRow, 4) = txtEntry(2).Text + toNumber(.TextMatrix(CurrRow, 4))
.TextMatrix(CurrRow, 5) = txtEntry(3).Text + toNumber(.TextMatrix(CurrRow, 5))
.TextMatrix(CurrRow, 6) = txtEntry(4).Text + toNumber(.TextMatrix(CurrRow, 6))
.TextMatrix(CurrRow, 7) = toNumber(txtLQty.Text) + toNumber(.TextMatrix(CurrRow, 7))
.TextMatrix(CurrRow, 8) = toNumber(txtVIQty.Text) + toNumber(.TextMatrix(CurrRow, 8))
.TextMatrix(CurrRow, 9) = toNumber(txtQty.Text) + toNumber(.TextMatrix(CurrRow, 9))
.TextMatrix(CurrRow, 10) = toNumber(txtAmount.Text) + toNumber(.TextMatrix(CurrRow, 10))
.TextMatrix(CurrRow, 11) = dcProd.BoundText
End If
'Add the amount to current load amount
clAmount = clAmount + toNumber(txtAmount.Text)
txtCLAmount.Text = Format$(clAmount, "#,##0.00")
'Highlight the current row's column
.ColSel = 11
'Display a remove button
Grid_Click
'Reset the entry fields
ResetEntry
End With
End Sub
Private Sub btnProdAvailable_Click()
'Display Product Stock Info
frmStockViewer.show vbModal
End Sub
Private Sub btnRemove_Click()
'Remove selected load product
With Grid
'Update amount to current load amount
clAmount = clAmount - toNumber(Grid.TextMatrix(.RowSel, 10))
txtCLAmount.Text = Format$(clAmount, "#,##0.00")
'Update the record count
clRowCount = clRowCount - 1
If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
.RemoveItem (.RowSel)
End With
btnRemove.Visible = False
Grid_Click
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
'Verify the entries
If dcVan.BoundText = "" Then
MsgBox "Please select a van in the list.", vbExclamation
dcVan.SetFocus
Exit Sub
End If
If clRowCount < 1 Then
MsgBox "Please load a product first before you can save this record.", vbExclamation
dcProd.SetFocus
Exit Sub
End If
If MsgBox("This save the record.Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Screen.MousePointer = vbHourglass
Dim RSDetails As New Recordset
Dim EntryIsOK As Boolean
Dim ProdPK As Long 'Product Primary Key
Dim tC As Long 'Temporary Case - Based on actual product quantity
Dim tB As Long 'Temporary Box --^
Dim tP As Long 'Temporary Pieces --^
EntryIsOK = True
RSDetails.CursorLocation = adUseClient
RSDetails.Open "SELECT * FROM tbl_IC_LoadingDetails WHERE LoadingFK=" & PK, CN, adOpenStatic, adLockOptimistic
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
![LoadingNo] = txtEntry(0).Text
![Date] = dtpDate.Value
![VanFK] = dcVan.BoundText
.Update
End With
With Grid
'Save the details of the records
For c = 1 To clRowCount
.Row = c
If State = adStateAddMode Or State = adStatePopupMode Then
ProdPK = toNumber(.TextMatrix(c, 11))
tC = toNumber(getValueAt("SELECT PK,Cases FROM tbl_IC_Products WHERE PK=" & ProdPK, "Cases"))
tB = toNumber(getValueAt("SELECT PK,Boxes FROM tbl_IC_Products WHERE PK=" & ProdPK, "Boxes"))
tP = toNumber(getValueAt("SELECT PK,Pieces FROM tbl_IC_Products WHERE PK=" & ProdPK, "Pieces"))
If toNumber(.TextMatrix(c, 4)) > tC Then EntryIsOK = False: .Col = 4: .CellForeColor = &HFF&: .CellFontBold = True
If toNumber(.TextMatrix(c, 5)) > tB Then EntryIsOK = False: .Col = 5: .CellForeColor = &HFF&: .CellFontBold = True
If toNumber(.TextMatrix(c, 6)) > tP Then EntryIsOK = False: .Col = 6: .CellForeColor = &HFF&: .CellFontBold = True
RSDetails.AddNew
RSDetails![PK] = getIndex("tbl_IC_LoadingDetails")
RSDetails![LoadingFK] = PK
RSDetails![ProductFK] = ProdPK
RSDetails![UnitCost(Each)] = .TextMatrix(c, 3)
RSDetails![Cases] = .TextMatrix(c, 4)
RSDetails![Boxes] = .TextMatrix(c, 5)
RSDetails![Pieces] = .TextMatrix(c, 6)
RSDetails![QtyLoad] = .TextMatrix(c, 7)
RSDetails![VanInv] = .TextMatrix(c, 8)
RSDetails.Update
'Update stock value
ChangeValue CN, "tbl_IC_Products", "Cases", tC - toNumber(.TextMatrix(c, 4)), True, "WHERE PK=" & ProdPK
ChangeValue CN, "tbl_IC_Products", "Boxes", tB - toNumber(.TextMatrix(c, 5)), True, "WHERE PK=" & ProdPK
ChangeValue CN, "tbl_IC_Products", "Pieces", tP - toNumber(.TextMatrix(c, 6)), True, "WHERE PK=" & ProdPK
End If
Next c
End With
'Clear variables
c = 0
ProdPK = 0
tC = 0
tB = 0
tP = 0
Set RSDetails = Nothing
If EntryIsOK = True Then
CN.CommitTrans
Else
CN.RollbackTrans
MsgBox "Some product/s have not enough quantity to serve for this loading." & vbCrLf & _
"Please check the stock value of the loaded products with red color in the list.", vbExclamation
Grid.Row = 1
Grid.Col = 0
'Grid.ColSel = 11
Grid.SetFocus
Screen.MousePointer = vbDefault
Exit Sub
End If
HaveAction = True
Screen.MousePointer = vbDefault
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
GeneratePK
Else
Unload Me
End If
Else
MsgBox "Changes in record has been successfully saved.", vbInformation
Unload Me
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -