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

change basket print behaviour

Browse Source
This commit is contained in:
Trowbridge 2019-03-20 12:47:01 -04:00
parent f5a60c7b7c
commit ae5515a83e
1 changed files with 17 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
months.cls
View File

@ -75,7 +75,6 @@ Attribute picker_shortcut.VB_ProcData.VB_Invoke_Func = "I\n14"
If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Call Me.basket_pick(Selection)
End If
Selection.Select
End Sub
@ -307,7 +306,6 @@ End Sub
Sub load_sheet()
units = Sheets("_month").Range("A2:E13").FormulaR1C1
price = Sheets("_month").Range("F2:J13").FormulaR1C1
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
@ -316,14 +314,13 @@ Sub load_sheet()
tprice = Range("H18:L18")
tsales = Range("N18:R18")
'reset basket
Sheets("_month").Range("U1:X10000").ClearContents
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
ReDim adjust(12)
Call Me.crunch_array
Call Me.set_sheet
Call Me.print_basket
End Sub
Sub set_format()
@ -575,69 +572,38 @@ Sub reset()
End Sub
Sub show_basket()
Attribute show_basket.VB_ProcData.VB_Invoke_Func = " \n14"
Sub switch_basket()
Attribute switch_basket.VB_ProcData.VB_Invoke_Func = " \n14"
If Sheets("config").Cells(6, 2) = 1 Then
Sheets("config").Cells(6, 2) = 0
dumping = True
Worksheets("month").Range("B32:Q10000").ClearContents
Rows("20:31").Hidden = False
dumping = False
Exit Sub
End If
Else
Sheets("config").Cells(6, 2) = 1
End If
Dim i As Long
Dim basket() As Variant
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
dumping = True
'Application.ScreenUpdating = False
'Set orig = Selection
'ActiveWindow.FreezePanes = False
For i = 1 To UBound(basket, 1)
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
Next i
'Rows("20:20").Select
'ActiveWindow.FreezePanes = True
'Rows("20:31").Select
'Selection.EntireRow.Hidden = True
Rows("20:31").Hidden = True
'orig.Select
'Application.ScreenUpdating = True
dumping = False
Call Me.print_basket
End Sub
Sub print_basket()
Sheets("config").Cells(6, 2) = 1
'Sheets("config").Cells(6, 2) = 1
If Sheets("config").Cells(6, 2) = 0 Then
dumping = True
Worksheets("month").Range("B32:Q10000").ClearContents
Rows("20:31").Hidden = False
dumping = False
Exit Sub
End If
Dim i As Long
Dim basket() As Variant
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
dumping = True
'Application.ScreenUpdating = False
'Set orig = Selection
'ActiveWindow.FreezePanes = False
Worksheets("month").Range("B32:Q10000").ClearContents
For i = 1 To UBound(basket, 1)
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
@ -646,15 +612,7 @@ Sub print_basket()
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
Next i
'Rows("20:20").Select
'ActiveWindow.FreezePanes = True
'Rows("20:31").Select
'Selection.EntireRow.Hidden = True
Rows("20:31").Hidden = True
'orig.Select
'Application.ScreenUpdating = True
dumping = False
@ -693,7 +651,8 @@ Attribute basket_pick.VB_ProcData.VB_Invoke_Func = "I\n14"
Set basket_touch = Nothing
End If
Sheets("month").Select
target.Select
End Sub