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

Compare commits

base: pt:988f72996a88a45dd4ebc948a2e5a293905d083a
Branches Tags
pt:master
...
compare: pt:043c7264bf222ff720d5959a155e77a99c4bdf04
Branches Tags
pt:master

3 Commits
988f72996a ... 043c7264bf

Author SHA1 Message Date
Trowbridge
043c7264bf various changes 2020-02-25 10:56:18 -05:00
pt
1ca398bb8e minor updates 2020-02-19 23:03:48 -05:00
Trowbridge
8e467677c4 add customized ribbon 2020-02-19 11:44:29 -05:00
8 changed files with 286 additions and 182 deletions
Show Stats Expand all files Collapse all files

54
Transform_Ribbon.xml Normal file
View File

@ -0,0 +1,54 @@
<mso:cmd app="Excel" dt="1" />
<mso:customUI xmlns:x1="http://schemas.microsoft.com/office/2009/07/customui/macro"
xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui">
<mso:ribbon>
<mso:qat>
<mso:sharedControls>
<mso:control idQ="mso:AutoSaveSwitch" visible="true"/>
<mso:control idQ="mso:FileOpenUsingBackstage" visible="false" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:FileSave" visible="true" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:FileSendAsAttachment" visible="false" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:Spelling" visible="false" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:Undo" visible="true" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:Redo" visible="true" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:SortAscendingExcel" visible="false" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:SortDescendingExcel" visible="false" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:PointerModeOptions" visible="false" insertBeforeQ="mso:FileNewDefault"/>
<mso:control idQ="mso:FileNewDefault" visible="true"/>
<mso:control idQ="mso:PrintAreaSetPrintArea" visible="true" insertBeforeQ="mso:FilePrintQuick"/>
<mso:control idQ="mso:PrintPreviewAndPrint" visible="true" insertBeforeQ="mso:FilePrintQuick"/>
<mso:control idQ="mso:FilePrintQuick" visible="true"/>
</mso:sharedControls>
</mso:qat>
<mso:tabs>
<mso:tab idQ="mso:TabDrawInk" visible="false"/>
<mso:tab id="mso_c1.43517DFC" label="Transform" insertBeforeQ="mso:TabAddIns">
<mso:group id="mso_c2.43517DFC" label="SQL" imageMso="DatabaseCopyDatabaseFile" autoScale="true">
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_sql_from_range_db2_noqh_0_42F27E58" label="Db2" imageMso="ObjectsUngroup" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!sql_from_range_db2_noqh" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_sql_from_range_db2_qh_1_42F27E58" label="Db2 Quoted" imageMso="ObjectsGroup" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!sql_from_range_db2_qh" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_sql_from_range_pg_noqh_2_42F27E58" label="Postgres" imageMso="ObjectsUngroup" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!sql_from_range_pg_noqh" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_sql_from_range_pg_qh_3_42F27E58" label="Postgres Quoted" imageMso="ObjectsGroup" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!sql_from_range_pg_qh" visible="true"/>
</mso:group>
<mso:group id="mso_c3.4D08FE57" label="Markdown" autoScale="true">
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_markdown_from_table_0_4D0C515A" label="Table" imageMso="GridSettings" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!markdown_from_table" visible="true"/>
</mso:group>
<mso:group id="mso_c4.4D0933EE" label="JSON" autoScale="true">
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_json_from_table_pretty_1_4D0C515A" label="Table (pretty)" imageMso="DiagramRadialInsertClassic" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!json_from_table_pretty" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_json_from_table_2_4D0C515A" label="Table" imageMso="SmartArtChangeColorsGallery" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!json_from_table" visible="true"/>
</mso:group>
<mso:group id="mso_c1.4D1F6822" label="Build" autoScale="true">
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_Cross_Join_Selection_0_4D20E80B" label="CrossJoin" imageMso="HorizontalSpacingDecrease" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!Cross_Join_Selection" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_add_quote_front_0_1971CAD2" label="Quote" imageMso="MailMergeResultsPreview" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!add_quote_front" visible="true"/>
</mso:group>
<mso:group id="mso_c1.4D2435DE" label="Pivot" autoScale="true">
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_SetPivotShortcutKeys_0_4D25642D" label="Set Shortcut Keys" imageMso="DataGraphicIconSet" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!SetPivotShortcutKeys" visible="true"/>
</mso:group>
<mso:group id="mso_c1.BF3D88E" label="Pricing" autoScale="true">
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_extract_price_matrix_0_6747C9F" label="Build" imageMso="Bullets" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!extract_price_matrix" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_go_to_price_issue_0_C42F4B1" label="Issue" imageMso="TraceError" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!go_to_price_issue" visible="true"/>
<mso:button idQ="x1:C:_Users_PTrowbridge_AppData_Roaming_Microsoft_Excel_XLSTART_PERSONAL.XLSB_build_price_upload_0_10A0DD72" label="Upload" imageMso="_3DPerspectiveIncrease" onAction="%appdata%\Microsoft\Excel\XLSTART\PERSONAL.XLSB!build_price_upload" visible="true"/>
</mso:group>
</mso:tab>
</mso:tabs>
</mso:ribbon>
</mso:customUI>

76
changes.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
Caption = "History" Caption = "History"
ClientHeight = 7740 ClientHeight = 7785
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 16260 ClientWidth = 16710
OleObjectBlob = "changes.frx":0000 OleObjectBlob = "changes.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -13,7 +13,7 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False Attribute VB_Exposed = False
Private x As Variant Private X As Variant
Private Sub cbCancel_Click() Private Sub cbCancel_Click()
@ -23,24 +23,8 @@ End Sub
Private Sub cbUndo_Click() 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
Call Me.delete_selected
End Sub End Sub
@ -50,7 +34,7 @@ Private Sub lbHist_Change()
For i = 0 To Me.lbHist.ListCount - 1 For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then If Me.lbHist.Selected(i) Then
Me.tbPrint.value = x(i, 6) Me.tbPrint.value = X(i, 7)
Exit Sub Exit Sub
End If End If
Next i Next i
@ -61,17 +45,63 @@ End Sub
Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 46
Call Me.delete_selected
Case 27
Call Me.Hide
End Select
End Sub
Private Sub tbPrint_Change()
End Sub
Private Sub UserForm_Activate() Private Sub UserForm_Activate()
Dim fail As Boolean Dim fail As Boolean
'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail) 'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
x = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail) X = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
If fail Then If fail Then
Me.Hide Me.Hide
Exit Sub Exit Sub
End If End If
Me.lbHist.list = x Me.lbHist.list = X
End Sub End Sub
Sub delete_selected()
Dim logid As Integer
Dim i As Integer
Dim fail As Boolean
Dim proceed As Boolean
If MsgBox("Permanently delete these changes?", vbOKCancel) = vbCancel 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") basket(i, 3) = sp("package")("basket")(i)("mix")
Next i Next i
'-------------load tags-------------------------------
If Not IsNull(sp("package")("tags")) Then If Not IsNull(sp("package")("tags")) Then
ReDim tags(sp("package")("tags").Count - 1, 0) ReDim tags(sp("package")("tags").Count - 1, 0)
For i = 1 To sp("package")("tags").Count For i = 1 To sp("package")("tags").Count
@ -572,8 +574,15 @@ Private Sub UserForm_Activate()
Next i Next i
cbTAG.list = tags cbTAG.list = tags
Sheets("month").cbMTAG.list = tags Sheets("month").cbMTAG.list = tags
cbTAG.ListRows = UBound(tags, 1) + 1
months.cbMTAG.ListRows = UBound(tags, 1) + 1
End If End If
'----------reset spinner buttons----------------------
sbpd.value = 0
sbpp.value = 0
sbpd.value = 0
Call handler.month_tosheet(month, basket) Call handler.month_tosheet(month, basket)
Application.StatusBar = False Application.StatusBar = False

BIN
fpvt.frx
View File

Binary file not shown.

191
handler.bas
View File

@ -5,7 +5,7 @@ Public sql As String
Public jsql As String Public jsql As String
Public scenario As String Public scenario As String
Public sc() As Variant Public sc() As Variant
Public x As New TheBigOne Public X As New TheBigOne
Public wapi As New Windows_API Public wapi As New Windows_API
Public data() As String Public data() As String
Public agg() As String Public agg() As String
@ -103,7 +103,7 @@ Sub pg_main_workset(rep As String)
Exit Sub Exit Sub
End If End If
Set json = JsonConverter.ParseJson(wr) Set json = JsonConverter.ParseJson(wr)
ReDim res(json("x").Count, 32) ReDim res(json("x").Count, 33)
For i = 1 To UBound(res, 1) For i = 1 To UBound(res, 1)
res(i, 0) = json("x")(i)("bill_cust_descr") res(i, 0) = json("x")(i)("bill_cust_descr")
@ -113,32 +113,33 @@ Sub pg_main_workset(rep As String)
res(i, 4) = json("x")(i)("quota_rep_descr") res(i, 4) = json("x")(i)("quota_rep_descr")
res(i, 5) = json("x")(i)("director") res(i, 5) = json("x")(i)("director")
res(i, 6) = json("x")(i)("segm") res(i, 6) = json("x")(i)("segm")
res(i, 7) = json("x")(i)("chan") res(i, 7) = json("x")(i)("substance")
res(i, 8) = json("x")(i)("chansub") res(i, 8) = json("x")(i)("chan")
res(i, 9) = json("x")(i)("part_descr") res(i, 9) = json("x")(i)("chansub")
res(i, 10) = json("x")(i)("part_group") res(i, 10) = json("x")(i)("part_descr")
res(i, 11) = json("x")(i)("branding") res(i, 11) = json("x")(i)("part_group")
res(i, 12) = json("x")(i)("majg_descr") res(i, 12) = json("x")(i)("branding")
res(i, 13) = json("x")(i)("ming_descr") res(i, 13) = json("x")(i)("majg_descr")
res(i, 14) = json("x")(i)("majs_descr") res(i, 14) = json("x")(i)("ming_descr")
res(i, 15) = json("x")(i)("mins_descr") res(i, 15) = json("x")(i)("majs_descr")
res(i, 16) = json("x")(i)("order_season") res(i, 16) = json("x")(i)("mins_descr")
res(i, 17) = json("x")(i)("order_month") res(i, 17) = json("x")(i)("order_season")
res(i, 18) = json("x")(i)("ship_season") res(i, 18) = json("x")(i)("order_month")
res(i, 19) = json("x")(i)("ship_month") res(i, 19) = json("x")(i)("ship_season")
res(i, 20) = json("x")(i)("request_season") res(i, 20) = json("x")(i)("ship_month")
res(i, 21) = json("x")(i)("request_month") res(i, 21) = json("x")(i)("request_season")
res(i, 22) = json("x")(i)("promo") res(i, 22) = json("x")(i)("request_month")
res(i, 23) = json("x")(i)("value_loc") res(i, 23) = json("x")(i)("promo")
res(i, 24) = json("x")(i)("value_usd") res(i, 24) = json("x")(i)("value_loc")
res(i, 25) = json("x")(i)("cost_loc") res(i, 25) = json("x")(i)("value_usd")
res(i, 26) = json("x")(i)("cost_usd") res(i, 26) = json("x")(i)("cost_loc")
res(i, 27) = json("x")(i)("units") res(i, 27) = json("x")(i)("cost_usd")
res(i, 28) = json("x")(i)("version") res(i, 28) = json("x")(i)("units")
res(i, 29) = json("x")(i)("iter") res(i, 29) = json("x")(i)("version")
res(i, 30) = json("x")(i)("logid") res(i, 30) = json("x")(i)("iter")
res(i, 31) = json("x")(i)("tag") res(i, 31) = json("x")(i)("logid")
res(i, 32) = json("x")(i)("comment") res(i, 32) = json("x")(i)("tag")
res(i, 33) = json("x")(i)("comment")
Next i Next i
res(0, 0) = "bill_cust_descr" res(0, 0) = "bill_cust_descr"
@ -148,39 +149,40 @@ Sub pg_main_workset(rep As String)
res(0, 4) = "quota_rep_descr" res(0, 4) = "quota_rep_descr"
res(0, 5) = "director" res(0, 5) = "director"
res(0, 6) = "segm" res(0, 6) = "segm"
res(0, 7) = "chan" res(0, 7) = "substance"
res(0, 8) = "chansub" res(0, 8) = "chan"
res(0, 9) = "part_descr" res(0, 9) = "chansub"
res(0, 10) = "part_group" res(0, 10) = "part_descr"
res(0, 11) = "branding" res(0, 11) = "part_group"
res(0, 12) = "majg_descr" res(0, 12) = "branding"
res(0, 13) = "ming_descr" res(0, 13) = "majg_descr"
res(0, 14) = "majs_descr" res(0, 14) = "ming_descr"
res(0, 15) = "mins_descr" res(0, 15) = "majs_descr"
res(0, 16) = "order_season" res(0, 16) = "mins_descr"
res(0, 17) = "order_month" res(0, 17) = "order_season"
res(0, 18) = "ship_season" res(0, 18) = "order_month"
res(0, 19) = "ship_month" res(0, 19) = "ship_season"
res(0, 20) = "request_season" res(0, 20) = "ship_month"
res(0, 21) = "request_month" res(0, 21) = "request_season"
res(0, 22) = "promo" res(0, 22) = "request_month"
res(0, 23) = "value_loc" res(0, 23) = "promo"
res(0, 24) = "value_usd" res(0, 24) = "value_loc"
res(0, 25) = "cost_loc" res(0, 25) = "value_usd"
res(0, 26) = "cost_usd" res(0, 26) = "cost_loc"
res(0, 27) = "units" res(0, 27) = "cost_usd"
res(0, 28) = "version" res(0, 28) = "units"
res(0, 29) = "iter" res(0, 29) = "version"
res(0, 30) = "logid" res(0, 30) = "iter"
res(0, 31) = "tag" res(0, 31) = "logid"
res(0, 32) = "comment" res(0, 32) = "tag"
res(0, 33) = "comment"
Set json = Nothing Set json = Nothing
ReDim str(UBound(res, 1), UBound(res, 2)) ReDim str(UBound(res, 1), UBound(res, 2))
Worksheets("data").Cells.ClearContents Worksheets("data").Cells.ClearContents
Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True) Call X.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
End Sub End Sub
@ -249,42 +251,43 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Exit Function Exit Function
End If End If
ReDim res(json("x").Count - 1, 32) ReDim res(json("x").Count - 1, 33)
For i = 1 To UBound(res, 1) + 1 For i = 0 To UBound(res, 1)
res(i - 1, 0) = json("x")(i)("bill_cust_descr") res(i, 0) = json("x")(i + 1)("bill_cust_descr")
res(i - 1, 1) = json("x")(i)("billto_group") res(i, 1) = json("x")(i + 1)("billto_group")
res(i - 1, 2) = json("x")(i)("ship_cust_descr") res(i, 2) = json("x")(i + 1)("ship_cust_descr")
res(i - 1, 3) = json("x")(i)("shipto_group") res(i, 3) = json("x")(i + 1)("shipto_group")
res(i - 1, 4) = json("x")(i)("quota_rep_descr") res(i, 4) = json("x")(i + 1)("quota_rep_descr")
res(i - 1, 5) = json("x")(i)("director") res(i, 5) = json("x")(i + 1)("director")
res(i - 1, 6) = json("x")(i)("segm") res(i, 6) = json("x")(i + 1)("segm")
res(i - 1, 7) = json("x")(i)("chan") res(i, 7) = json("x")(i + 1)("substance")
res(i - 1, 8) = json("x")(i)("chansub") res(i, 8) = json("x")(i + 1)("chan")
res(i - 1, 9) = json("x")(i)("part_descr") res(i, 9) = json("x")(i + 1)("chansub")
res(i - 1, 10) = json("x")(i)("part_group") res(i, 10) = json("x")(i + 1)("part_descr")
res(i - 1, 11) = json("x")(i)("branding") res(i, 11) = json("x")(i + 1)("part_group")
res(i - 1, 12) = json("x")(i)("majg_descr") res(i, 12) = json("x")(i + 1)("branding")
res(i - 1, 13) = json("x")(i)("ming_descr") res(i, 13) = json("x")(i + 1)("majg_descr")
res(i - 1, 14) = json("x")(i)("majs_descr") res(i, 14) = json("x")(i + 1)("ming_descr")
res(i - 1, 15) = json("x")(i)("mins_descr") res(i, 15) = json("x")(i + 1)("majs_descr")
res(i - 1, 16) = json("x")(i)("order_season") res(i, 16) = json("x")(i + 1)("mins_descr")
res(i - 1, 17) = json("x")(i)("order_month") res(i, 17) = json("x")(i + 1)("order_season")
res(i - 1, 18) = json("x")(i)("ship_season") res(i, 18) = json("x")(i + 1)("order_month")
res(i - 1, 19) = json("x")(i)("ship_month") res(i, 19) = json("x")(i + 1)("ship_season")
res(i - 1, 20) = json("x")(i)("request_season") res(i, 20) = json("x")(i + 1)("ship_month")
res(i - 1, 21) = json("x")(i)("request_month") res(i, 21) = json("x")(i + 1)("request_season")
res(i - 1, 22) = json("x")(i)("promo") res(i, 22) = json("x")(i + 1)("request_month")
res(i - 1, 23) = json("x")(i)("value_loc") res(i, 23) = json("x")(i + 1)("promo")
res(i - 1, 24) = json("x")(i)("value_usd") res(i, 24) = json("x")(i + 1)("value_loc")
res(i - 1, 25) = json("x")(i)("cost_loc") res(i, 25) = json("x")(i + 1)("value_usd")
res(i - 1, 26) = json("x")(i)("cost_usd") res(i, 26) = json("x")(i + 1)("cost_loc")
res(i - 1, 27) = json("x")(i)("units") res(i, 27) = json("x")(i + 1)("cost_usd")
res(i - 1, 28) = json("x")(i)("version") res(i, 28) = json("x")(i + 1)("units")
res(i - 1, 29) = json("x")(i)("iter") res(i, 29) = json("x")(i + 1)("version")
res(i - 1, 30) = json("x")(i)("logid") res(i, 30) = json("x")(i + 1)("iter")
res(i - 1, 31) = json("x")(i)("tag") res(i, 31) = json("x")(i + 1)("logid")
res(i - 1, 32) = json("x")(i)("comment") res(i, 32) = json("x")(i + 1)("tag")
res(i, 33) = json("x")(i + 1)("comment")
Next i Next i
Set json = Nothing Set json = Nothing
@ -306,7 +309,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
i = i + 1 i = i + 1
Loop Loop
Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True) Call X.SHTp_DumpVar(res, "data", i, 1, False, False, True)
'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32) 'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
@ -450,8 +453,8 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
'basket 'basket
sh.Range("U1:AC100000").ClearContents sh.Range("U1:AC100000").ClearContents
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True) Call X.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True) Call X.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
Sheets("config").Cells(5, 2) = 0 Sheets("config").Cells(5, 2) = 0
Sheets("config").Cells(6, 2) = 0 Sheets("config").Cells(6, 2) = 0
Sheets("config").Cells(7, 2) = 0 Sheets("config").Cells(7, 2) = 0
@ -515,7 +518,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
res(i, 4) = json("x")(i + 1)("comment") res(i, 4) = json("x")(i + 1)("comment")
res(i, 5) = json("x")(i + 1)("sales") res(i, 5) = json("x")(i + 1)("sales")
res(i, 6) = json("x")(i + 1)("id") res(i, 6) = json("x")(i + 1)("id")
res(i, 7) = json("x")(i + 1)("def") res(i, 7) = json("x")(i + 1)("doc")
Next i Next i
list_changes = res list_changes = res

112
months.cls
View File

@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True Attribute VB_Exposed = True
Option Explicit Option Explicit
Private x As New TheBigOne Private X As New TheBigOne
Private units() As Variant Private units() As Variant
Private price() As Variant Private price() As Variant
Private sales() As Variant Private sales() As Variant
@ -28,6 +28,7 @@ Private basket_touch As Range
Private showbasket As Boolean Private showbasket As Boolean
Private np As Object 'json dedicated to new part scenario Private np As Object 'json dedicated to new part scenario
Private b() As Variant 'holds basket Private b() As Variant 'holds basket
Private did_load_config As Boolean
@ -89,12 +90,18 @@ Private Sub tbMCOM_Change()
End Sub 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 dumping Then
If Not Intersect(target, Range("A1:R18")) Is Nothing Then If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
If target.Columns.Count > 1 Then If Target.Columns.Count > 1 Then
MsgBox ("you can only change one column at a time - your change will be undone") MsgBox ("you can only change one column at a time - your change will be undone")
dumping = True dumping = True
Application.Undo Application.Undo
@ -103,15 +110,15 @@ Private Sub Worksheet_Change(ByVal target As Range)
End If End If
End If End If
If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj 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("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("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("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("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("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 If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
Set basket_touch = target Set basket_touch = Target
Call Me.get_edit_basket Call Me.get_edit_basket
Set basket_touch = Nothing Set basket_touch = Nothing
End If End If
@ -119,13 +126,13 @@ Private Sub Worksheet_Change(ByVal target As Range)
End If End If
End Sub 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 cancel = True
Call Me.basket_pick(target) Call Me.basket_pick(Target)
target.Select Target.Select
End If End If
End Sub End Sub
@ -139,12 +146,12 @@ Sub picker_shortcut()
End Sub 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 cancel = True
Call Me.basket_pick(target) Call Me.basket_pick(Target)
target.Select Target.Select
End If End If
End Sub End Sub
@ -354,7 +361,7 @@ Sub set_sheet()
Range("H18:L18").FormulaR1C1 = tprice Range("H18:L18").FormulaR1C1 = tprice
Range("N18:R18").FormulaR1C1 = tsales Range("N18:R18").FormulaR1C1 = tsales
Range("T6:U18").ClearContents Range("T6:U18").ClearContents
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False) Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
'Sheets("month").Range("B32:Q5000").ClearContents 'Sheets("month").Range("B32:Q5000").ClearContents
If Me.newpart Then If Me.newpart Then
@ -381,12 +388,13 @@ Sub load_sheet()
tsales = Range("N18:R18") tsales = Range("N18:R18")
'reset basket 'reset basket
Sheets("_month").Range("U1:X10000").ClearContents Sheets("_month").Range("U1:X10000").ClearContents
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False) Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
ReDim adjust(12) ReDim adjust(12)
Call Me.crunch_array Call Me.crunch_array
Call Me.set_sheet Call Me.set_sheet
Call Me.print_basket Call Me.print_basket
Call Me.set_format Call Me.set_format
did_load_config = False
End Sub End Sub
@ -474,9 +482,9 @@ Sub set_border(ByRef targ As Range)
End Sub End Sub
Sub fill_yellow(ByRef target As Range) Sub fill_yellow(ByRef Target As Range)
With target.Interior With Target.Interior
.Pattern = xlSolid .Pattern = xlSolid
.PatternColorIndex = xlAutomatic .PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4 .ThemeColor = xlThemeColorAccent4
@ -486,10 +494,10 @@ Sub fill_yellow(ByRef target As Range)
End Sub End Sub
Sub fill_grey(ByRef target As Range) Sub fill_grey(ByRef Target As Range)
With target.Interior With Target.Interior
.Pattern = xlSolid .Pattern = xlSolid
.PatternColorIndex = xlAutomatic .PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1 .ThemeColor = xlThemeColorDark1
@ -499,9 +507,9 @@ Sub fill_grey(ByRef target As Range)
End Sub End Sub
Sub fill_none(ByRef target As Range) Sub fill_none(ByRef Target As Range)
With target.Interior With Target.Interior
.Pattern = xlNone .Pattern = xlNone
.TintAndShade = 0 .TintAndShade = 0
.PatternTintAndShade = 0 .PatternTintAndShade = 0
@ -509,15 +517,15 @@ Sub fill_none(ByRef target As Range)
End Sub 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 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 End Sub
@ -611,9 +619,9 @@ Sub build_json()
'np("basket") = x.json_from_table(b, "basket", False) 'np("basket") = x.json_from_table(b, "basket", False)
'get the basket from the sheet 'get the basket from the sheet
b = Worksheets("_month").Range("U1").CurrentRegion.value b = Worksheets("_month").Range("U1").CurrentRegion.value
Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False)) Set m = JsonConverter.ParseJson(X.json_from_table(b, "basket", False))
If UBound(b, 1) <= 2 Then If UBound(b, 1) <= 2 Then
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]") Set np("basket") = JsonConverter.ParseJson("[" & X.json_from_table(b, "basket", False) & "]")
Else Else
Set np("basket") = m("basket") Set np("basket") = m("basket")
End If End If
@ -718,7 +726,7 @@ Sub print_basket()
Dim i As Long Dim i As Long
Dim basket() As Variant Dim basket() As Variant
basket = x.SHTp_get_block(Sheets("_month").Range("U1")) basket = X.SHTp_get_block(Sheets("_month").Range("U1"))
dumping = True dumping = True
@ -730,45 +738,45 @@ Sub print_basket()
Sheets("month").Cells(31 + i, 17) = basket(i, 4) Sheets("month").Cells(31 + i, 17) = basket(i, 4)
Next i Next i
Rows("20:31").Hidden = True Rows("21:31").Hidden = True
dumping = False dumping = False
End Sub End Sub
Sub basket_pick(ByRef target As Range) Sub basket_pick(ByRef Target As Range)
Dim i As Long Dim i As Long
build.part = Sheets("month").Cells(target.row, 2) build.part = Sheets("month").Cells(Target.row, 2)
build.bill = rev_cust(Sheets("month").Cells(target.row, 6)) build.bill = rev_cust(Sheets("month").Cells(Target.row, 6))
build.ship = rev_cust(Sheets("month").Cells(target.row, 12)) build.ship = rev_cust(Sheets("month").Cells(Target.row, 12))
build.useval = False build.useval = False
build.Show build.Show
If build.useval Then If build.useval Then
dumping = True dumping = True
'if an empty row is selected, force it to be the next open slot 'if an empty row is selected, force it to be the next open slot
If Sheets("month").Cells(target.row, 2) = "" Then If Sheets("month").Cells(Target.row, 2) = "" Then
Do Until Sheets("month").Cells(target.row + i, 2) <> "" Do Until Sheets("month").Cells(Target.row + i, 2) <> ""
i = i - 1 i = i - 1
Loop Loop
i = i + 1 i = i + 1
End If End If
Sheets("month").Cells(target.row + i, 2) = build.cbPart.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, 6) = rev_cust(build.cbBill.value)
Sheets("month").Cells(target.row + i, 12) = rev_cust(build.cbShip.value) Sheets("month").Cells(Target.row + i, 12) = rev_cust(build.cbShip.value)
dumping = False dumping = False
Set basket_touch = Selection Set basket_touch = Selection
Call Me.get_edit_basket Call Me.get_edit_basket
Set basket_touch = Nothing Set basket_touch = Nothing
End If End If
target.Select Target.Select
End Sub End Sub
@ -831,7 +839,7 @@ Sub get_edit_basket()
dumping = False dumping = False
Worksheets("_month").Range("U2:X5000").ClearContents Worksheets("_month").Range("U2:X5000").ClearContents
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True) Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
If Me.newpart Then If Me.newpart Then
Me.build_json Me.build_json
@ -902,7 +910,7 @@ Sub build_new()
'Call Me.set_sheet 'Call Me.set_sheet
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False) 'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
basket = x.SHTp_get_block(Worksheets("_month").Range("U1")) basket = X.SHTp_get_block(Worksheets("_month").Range("U1"))
Sheets("month").Cells(32, 2) = basket(1, 1) Sheets("month").Cells(32, 2) = basket(1, 1)
Sheets("month").Cells(32, 6) = basket(1, 2) Sheets("month").Cells(32, 6) = basket(1, 2)
Sheets("month").Cells(32, 12) = basket(1, 3) Sheets("month").Cells(32, 12) = basket(1, 3)
@ -925,8 +933,8 @@ Sub new_part()
'---------build customer mix------------------------------------------------------------------- '---------build customer mix-------------------------------------------------------------------
cust = x.SHTp_Get("_month", 1, 27, True) cust = X.SHTp_Get("_month", 1, 27, True)
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then If Not X.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
MsgBox ("error building customer mix") MsgBox ("error building customer mix")
End If End If
@ -970,8 +978,8 @@ Sub new_part()
i = i + 1 i = i + 1
Loop Loop
Worksheets("_month").Range("U2:AC10000").ClearContents Worksheets("_month").Range("U2:AC10000").ClearContents
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True) Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True) Call X.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
'------reset volume to copy base to forecsat and clear base------------------------------------ '------reset volume to copy base to forecsat and clear base------------------------------------

26
pivot.cls
View File

@ -9,15 +9,19 @@ Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True Attribute VB_Exposed = True
Option Explicit 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 Exit Sub
End If End If
On Error GoTo nopiv On Error GoTo nopiv
If target.Cells.PivotTable Is Nothing Then If Target.Cells.PivotTable Is Nothing Then
Exit Sub Exit Sub
End If End If
@ -39,15 +43,15 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean
Dim pi As PivotItem Dim pi As PivotItem
Dim wapi As New Windows_API Dim wapi As New Windows_API
Set ri = target.Cells.PivotCell.RowItems Set ri = Target.Cells.PivotCell.RowItems
Set ci = target.Cells.PivotCell.ColumnItems Set ci = Target.Cells.PivotCell.ColumnItems
Set df = target.Cells.PivotCell.DataField Set df = Target.Cells.PivotCell.DataField
Set rd = target.Cells.PivotTable.RowFields Set rd = Target.Cells.PivotTable.RowFields
Set cd = target.Cells.PivotTable.ColumnFields Set cd = Target.Cells.PivotTable.ColumnFields
ReDim handler.sc(ri.Count, 1) ReDim handler.sc(ri.Count, 1)
Set pt = target.Cells.PivotCell.PivotTable Set pt = Target.Cells.PivotCell.PivotTable
handler.sql = "" handler.sql = ""
handler.jsql = "" handler.jsql = ""
@ -116,7 +120,3 @@ Function escape_sql(ByVal text As String) As String
End Function End Function