minor updates
This commit is contained in:
parent
8e467677c4
commit
1ca398bb8e
69
changes.frm
69
changes.frm
@ -1,10 +1,10 @@
|
||||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
|
||||
Caption = "History"
|
||||
ClientHeight = 7740
|
||||
ClientHeight = 7785
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 16260
|
||||
ClientWidth = 17145
|
||||
OleObjectBlob = "changes.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
@ -23,24 +23,11 @@ End Sub
|
||||
|
||||
Private Sub cbUndo_Click()
|
||||
|
||||
Dim logid As Integer
|
||||
Dim i As Integer
|
||||
Dim fail As Boolean
|
||||
|
||||
For i = 0 To Me.lbHist.ListCount - 1
|
||||
If Me.lbHist.Selected(i) Then
|
||||
Call handler.undo_changes(x(i, 6), fail)
|
||||
If fail Then
|
||||
MsgBox ("undo did not work")
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
|
||||
|
||||
Me.Hide
|
||||
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call Me.delete_selected
|
||||
|
||||
End Sub
|
||||
|
||||
@ -50,7 +37,7 @@ Private Sub lbHist_Change()
|
||||
|
||||
For i = 0 To Me.lbHist.ListCount - 1
|
||||
If Me.lbHist.Selected(i) Then
|
||||
Me.tbPrint.value = x(i, 6)
|
||||
Me.tbPrint.value = x(i, 7)
|
||||
Exit Sub
|
||||
End If
|
||||
Next i
|
||||
@ -61,6 +48,20 @@ End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||
|
||||
Select Case KeyCode
|
||||
Case 46
|
||||
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then
|
||||
Exit Sub
|
||||
End If
|
||||
Call Me.delete_selected
|
||||
Case 27
|
||||
Call Me.Hide
|
||||
End Select
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UserForm_Activate()
|
||||
|
||||
Dim fail As Boolean
|
||||
@ -75,3 +76,31 @@ Private Sub UserForm_Activate()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub delete_selected()
|
||||
|
||||
Dim logid As Integer
|
||||
Dim i As Integer
|
||||
Dim fail As Boolean
|
||||
Dim proceed As Boolean
|
||||
|
||||
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
For i = 0 To Me.lbHist.ListCount - 1
|
||||
If Me.lbHist.Selected(i) Then
|
||||
Call handler.undo_changes(x(i, 6), fail)
|
||||
If fail Then
|
||||
MsgBox ("undo did not work")
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
|
||||
|
||||
Me.lbHist.clear
|
||||
Me.Hide
|
||||
|
||||
End Sub
|
||||
|
BIN
changes.frx
BIN
changes.frx
Binary file not shown.
9
fpvt.frm
9
fpvt.frm
@ -565,6 +565,8 @@ Private Sub UserForm_Activate()
|
||||
basket(i, 3) = sp("package")("basket")(i)("mix")
|
||||
Next i
|
||||
|
||||
|
||||
'-------------load tags-------------------------------
|
||||
If Not IsNull(sp("package")("tags")) Then
|
||||
ReDim tags(sp("package")("tags").Count - 1, 0)
|
||||
For i = 1 To sp("package")("tags").Count
|
||||
@ -572,8 +574,15 @@ Private Sub UserForm_Activate()
|
||||
Next i
|
||||
cbTAG.list = tags
|
||||
Sheets("month").cbMTAG.list = tags
|
||||
cbTAG.ListRows = UBound(tags, 1) + 1
|
||||
months.cbMTAG.ListRows = UBound(tags, 1) + 1
|
||||
End If
|
||||
|
||||
'----------reset spinner buttons----------------------
|
||||
sbpd.value = 0
|
||||
sbpp.value = 0
|
||||
sbpd.value = 0
|
||||
|
||||
Call handler.month_tosheet(month, basket)
|
||||
Application.StatusBar = False
|
||||
|
||||
|
88
months.cls
88
months.cls
@ -28,6 +28,7 @@ Private basket_touch As Range
|
||||
Private showbasket As Boolean
|
||||
Private np As Object 'json dedicated to new part scenario
|
||||
Private b() As Variant 'holds basket
|
||||
Private did_load_config As Boolean
|
||||
|
||||
|
||||
|
||||
@ -89,12 +90,18 @@ Private Sub tbMCOM_Change()
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_Change(ByVal target As Range)
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
|
||||
'---this needs checked prior to dumping check becuase % increase spinners are flagged as dumps
|
||||
If Not did_load_config Then
|
||||
Call handler.load_config
|
||||
did_load_config = True
|
||||
End If
|
||||
|
||||
If Not dumping Then
|
||||
|
||||
If Not Intersect(target, Range("A1:R18")) Is Nothing Then
|
||||
If target.Columns.Count > 1 Then
|
||||
If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
|
||||
If Target.Columns.Count > 1 Then
|
||||
MsgBox ("you can only change one column at a time - your change will be undone")
|
||||
dumping = True
|
||||
Application.Undo
|
||||
@ -103,15 +110,15 @@ Private Sub Worksheet_Change(ByVal target As Range)
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
|
||||
If Not Intersect(target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
|
||||
If Not Intersect(Target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(Target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(Target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(Target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
|
||||
If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
|
||||
|
||||
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
Set basket_touch = target
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
Set basket_touch = Target
|
||||
Call Me.get_edit_basket
|
||||
Set basket_touch = Nothing
|
||||
End If
|
||||
@ -119,13 +126,13 @@ Private Sub Worksheet_Change(ByVal target As Range)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
|
||||
|
||||
|
||||
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
cancel = True
|
||||
Call Me.basket_pick(target)
|
||||
target.Select
|
||||
Call Me.basket_pick(Target)
|
||||
Target.Select
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@ -139,12 +146,12 @@ Sub picker_shortcut()
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, cancel As Boolean)
|
||||
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, cancel As Boolean)
|
||||
|
||||
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||
cancel = True
|
||||
Call Me.basket_pick(target)
|
||||
target.Select
|
||||
Call Me.basket_pick(Target)
|
||||
Target.Select
|
||||
End If
|
||||
|
||||
End Sub
|
||||
@ -387,6 +394,7 @@ Sub load_sheet()
|
||||
Call Me.set_sheet
|
||||
Call Me.print_basket
|
||||
Call Me.set_format
|
||||
did_load_config = False
|
||||
|
||||
End Sub
|
||||
|
||||
@ -474,9 +482,9 @@ Sub set_border(ByRef targ As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub fill_yellow(ByRef target As Range)
|
||||
Sub fill_yellow(ByRef Target As Range)
|
||||
|
||||
With target.Interior
|
||||
With Target.Interior
|
||||
.Pattern = xlSolid
|
||||
.PatternColorIndex = xlAutomatic
|
||||
.ThemeColor = xlThemeColorAccent4
|
||||
@ -486,10 +494,10 @@ Sub fill_yellow(ByRef target As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub fill_grey(ByRef target As Range)
|
||||
Sub fill_grey(ByRef Target As Range)
|
||||
|
||||
|
||||
With target.Interior
|
||||
With Target.Interior
|
||||
.Pattern = xlSolid
|
||||
.PatternColorIndex = xlAutomatic
|
||||
.ThemeColor = xlThemeColorDark1
|
||||
@ -499,9 +507,9 @@ Sub fill_grey(ByRef target As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub fill_none(ByRef target As Range)
|
||||
Sub fill_none(ByRef Target As Range)
|
||||
|
||||
With target.Interior
|
||||
With Target.Interior
|
||||
.Pattern = xlNone
|
||||
.TintAndShade = 0
|
||||
.PatternTintAndShade = 0
|
||||
@ -509,15 +517,15 @@ Sub fill_none(ByRef target As Range)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub format_price(ByRef target As Range)
|
||||
Sub format_price(ByRef Target As Range)
|
||||
|
||||
target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
||||
Target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
||||
|
||||
End Sub
|
||||
|
||||
Sub format_number(ByRef target As Range)
|
||||
Sub format_number(ByRef Target As Range)
|
||||
|
||||
target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||
Target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||
|
||||
End Sub
|
||||
|
||||
@ -730,45 +738,45 @@ Sub print_basket()
|
||||
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
|
||||
Next i
|
||||
|
||||
Rows("20:31").Hidden = True
|
||||
Rows("21:31").Hidden = True
|
||||
|
||||
dumping = False
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub basket_pick(ByRef target As Range)
|
||||
Sub basket_pick(ByRef Target As Range)
|
||||
|
||||
Dim i As Long
|
||||
|
||||
|
||||
build.part = Sheets("month").Cells(target.row, 2)
|
||||
build.bill = rev_cust(Sheets("month").Cells(target.row, 6))
|
||||
build.ship = rev_cust(Sheets("month").Cells(target.row, 12))
|
||||
build.part = Sheets("month").Cells(Target.row, 2)
|
||||
build.bill = rev_cust(Sheets("month").Cells(Target.row, 6))
|
||||
build.ship = rev_cust(Sheets("month").Cells(Target.row, 12))
|
||||
build.useval = False
|
||||
build.Show
|
||||
|
||||
If build.useval Then
|
||||
dumping = True
|
||||
'if an empty row is selected, force it to be the next open slot
|
||||
If Sheets("month").Cells(target.row, 2) = "" Then
|
||||
Do Until Sheets("month").Cells(target.row + i, 2) <> ""
|
||||
If Sheets("month").Cells(Target.row, 2) = "" Then
|
||||
Do Until Sheets("month").Cells(Target.row + i, 2) <> ""
|
||||
i = i - 1
|
||||
Loop
|
||||
i = i + 1
|
||||
End If
|
||||
|
||||
|
||||
Sheets("month").Cells(target.row + i, 2) = build.cbPart.value
|
||||
Sheets("month").Cells(target.row + i, 6) = rev_cust(build.cbBill.value)
|
||||
Sheets("month").Cells(target.row + i, 12) = rev_cust(build.cbShip.value)
|
||||
Sheets("month").Cells(Target.row + i, 2) = build.cbPart.value
|
||||
Sheets("month").Cells(Target.row + i, 6) = rev_cust(build.cbBill.value)
|
||||
Sheets("month").Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
|
||||
dumping = False
|
||||
Set basket_touch = Selection
|
||||
Call Me.get_edit_basket
|
||||
Set basket_touch = Nothing
|
||||
|
||||
End If
|
||||
target.Select
|
||||
Target.Select
|
||||
|
||||
|
||||
End Sub
|
||||
|
26
pivot.cls
26
pivot.cls
@ -9,15 +9,19 @@ Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = True
|
||||
Option Explicit
|
||||
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
|
||||
Private Sub Worksheet_Activate()
|
||||
|
||||
If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
|
||||
|
||||
If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
On Error GoTo nopiv
|
||||
|
||||
If target.Cells.PivotTable Is Nothing Then
|
||||
If Target.Cells.PivotTable Is Nothing Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
@ -39,15 +43,15 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean
|
||||
Dim pi As PivotItem
|
||||
Dim wapi As New Windows_API
|
||||
|
||||
Set ri = target.Cells.PivotCell.RowItems
|
||||
Set ci = target.Cells.PivotCell.ColumnItems
|
||||
Set df = target.Cells.PivotCell.DataField
|
||||
Set ri = Target.Cells.PivotCell.RowItems
|
||||
Set ci = Target.Cells.PivotCell.ColumnItems
|
||||
Set df = Target.Cells.PivotCell.DataField
|
||||
|
||||
Set rd = target.Cells.PivotTable.RowFields
|
||||
Set cd = target.Cells.PivotTable.ColumnFields
|
||||
Set rd = Target.Cells.PivotTable.RowFields
|
||||
Set cd = Target.Cells.PivotTable.ColumnFields
|
||||
|
||||
ReDim handler.sc(ri.Count, 1)
|
||||
Set pt = target.Cells.PivotCell.PivotTable
|
||||
Set pt = Target.Cells.PivotCell.PivotTable
|
||||
|
||||
handler.sql = ""
|
||||
handler.jsql = ""
|
||||
@ -116,7 +120,3 @@ Function escape_sql(ByVal text As String) As String
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user