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

various changes

Browse Source
This commit is contained in:
Trowbridge 2020-02-25 10:56:18 -05:00
parent 1ca398bb8e
commit 043c7264bf
5 changed files with 123 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
changes.frm
View File

@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
ClientHeight = 7785 ClientHeight = 7785
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 17145 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,9 +23,6 @@ End Sub
Private Sub cbUndo_Click() Private Sub cbUndo_Click()
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then
Exit Sub
End If
Call Me.delete_selected Call Me.delete_selected
@ -37,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, 7) Me.tbPrint.value = X(i, 7)
Exit Sub Exit Sub
End If End If
Next i Next i
@ -52,9 +49,6 @@ Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Select Case KeyCode Select Case KeyCode
Case 46 Case 46
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then
Exit Sub
End If
Call Me.delete_selected Call Me.delete_selected
Case 27 Case 27
Call Me.Hide Call Me.Hide
@ -62,17 +56,24 @@ Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
End Sub 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
@ -83,14 +84,14 @@ Sub delete_selected()
Dim fail As Boolean Dim fail As Boolean
Dim proceed As Boolean Dim proceed As Boolean
If Not MsgBox("Permanently delete these changes?", vbOKCancel) Then If MsgBox("Permanently delete these changes?", vbOKCancel) = vbCancel Then
Exit Sub Exit Sub
End If End If
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
Call handler.undo_changes(x(i, 6), fail) Call handler.undo_changes(X(i, 6), fail)
If fail Then If fail Then
MsgBox ("undo did not work") MsgBox ("undo did not work")
Exit Sub Exit Sub

BIN
changes.frx
View File

Binary file not shown.

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

24
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
@ -361,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
@ -388,7 +388,7 @@ 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
@ -619,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
@ -726,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
@ -839,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
@ -910,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)
@ -933,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
@ -978,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------------------------------------