pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

minor updates

Browse Source
This commit is contained in:
pt 2020-02-19 23:03:48 -05:00
parent 8e467677c4
commit 1ca398bb8e
6 changed files with 119 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
changes.frm
View File

@ -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")
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then
Exit Sub
End If
End If
Next i
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
Me.Hide
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
View File

Binary file not shown.

9
fpvt.frm
View File

@ -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

BIN
fpvt.frx
View File

Binary file not shown.

88
months.cls
View File

@ -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
View File

@ -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