diff --git a/changes.frm b/changes.frm index 808ad72..6bd11e3 100644 --- a/changes.frm +++ b/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 diff --git a/changes.frx b/changes.frx index 8199186..bb4204b 100644 Binary files a/changes.frx and b/changes.frx differ diff --git a/fpvt.frm b/fpvt.frm index 3e4e17b..bc87436 100644 --- a/fpvt.frm +++ b/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 diff --git a/fpvt.frx b/fpvt.frx index 72157d8..d07e9ad 100644 Binary files a/fpvt.frx and b/fpvt.frx differ diff --git a/months.cls b/months.cls index c4309b4..f01cc03 100644 --- a/months.cls +++ b/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 diff --git a/pivot.cls b/pivot.cls index 2161ae5..0eb66da 100644 --- a/pivot.cls +++ b/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 - - - -