diff --git a/fpvt.frm b/fpvt.frm new file mode 100644 index 0000000..c94ba85 --- /dev/null +++ b/fpvt.frm @@ -0,0 +1,68 @@ +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt + Caption = "UserForm1" + ClientHeight = 6780 + ClientLeft = 120 + ClientTop = 465 + ClientWidth = 12735 + OleObjectBlob = "fpvt.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "fpvt" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Public mod_adjust As Boolean +Option Explicit + + + +Private Sub tbAdjVal_Change() + + If IsNumeric(tbAdjVal.value) Then + tbFcVal = Format(CDbl(tbAdjVal.value) + CDbl(tbBaseVal.value), "#,###") + Else + tbFcVal = Format(CDbl(tbBaseVal.value), "#,###") + End If + +End Sub + +Private Sub UserForm_Activate() + + Dim s_tot As Object + Dim i As Long + + Set s_tot = handler.scenario_totals(handler.scenario) + + '---show existing adjustment if there is one---- + fpvt.mod_adjust = False + fpvt.lOrigAdj.Visible = False + fpvt.tbOrigAdj.Visible = False + + For i = 1 To s_tot("x").Count + Select Case s_tot("x")(i)("order_season") + Case 2020 + Select Case s_tot("x")(i)("iter") + Case "copy" + fpvt.tbBaseVol.Text = Format(s_tot("x")(i)("units"), "#,###") + fpvt.tbBaseVal.Text = Format(s_tot("x")(i)("value_usd"), "#,###") + + Case "adjustment" + fpvt.tbAdjVol.Text = Format(s_tot("x")(i)("units"), "#,###") + fpvt.tbAdjVal.Text = Format(s_tot("x")(i)("value_usd"), "#,###") + + '---show existing adjustment if there is one---- + fpvt.mod_adjust = True + fpvt.lOrigAdj.Visible = True + fpvt.tbOrigAdj.Visible = True + fpvt.tbOrigAdj.value = Format(s_tot("x")(i)("value_usd"), "#,###") + End Select + End Select + Next i + + fpvt.tbFcVol.Text = Format(fpvt.tbBaseVol.value + fpvt.tbAdjVol.value, "#,###") + fpvt.tbFcVal.Text = Format(fpvt.tbBaseVal.value + fpvt.tbAdjVal.value, "#,###") + + sbEdit.SimpleText = "idle" +End Sub diff --git a/fpvt.frx b/fpvt.frx new file mode 100644 index 0000000..aa1dda1 Binary files /dev/null and b/fpvt.frx differ diff --git a/handler.bas b/handler.bas index 89df86b..ea6ff62 100644 --- a/handler.bas +++ b/handler.bas @@ -6,14 +6,74 @@ Public scenario As String Public sc() As Variant Public x As New TheBigOne Public wapi As New Windows_API +Public data() As String +Public agg() As String +Public showprice As Boolean Sub load_fpvt() - Call wapi.ClipBoard_SetData(sql) - + fpvt.sbEdit.SimpleText = "retrieving data.........." + + 'data = x.SHTp_Get("data", 1, 1, True) + 'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30)) + Dim i As Long + Dim s_tot As Object + + fpvt.ListBox1.list = handler.sc + + showprice = False + + For i = 0 To UBound(handler.sc, 1) + If handler.sc(i, 0) = "part_descr" Then + showprice = True + Exit For + End If + Next i + + If showprice Then + fpvt.opvolume.Visible = False + fpvt.opprice.Visible = False + 'fpvt.tbBasePrice.BackColor = &H80000005 + 'fpvt.tbBaseVol.BackColor = &H80000005 + fpvt.tbAdjPrice.BackColor = &H80000005 + fpvt.tbAdjVol.BackColor = &H80000005 + fpvt.tbAdjVal.BackColor = &H80000004 + fpvt.tbAdjVal.Enabled = False + 'fpvt.tbFcPrice.BackColor = &H80000005 + 'fpvt.tbFcVol.BackColor = &H80000005 + 'enabled + 'fpvt.tbBasePrice.Enabled = True + 'fpvt.tbBaseVol.Enabled = True + fpvt.tbAdjPrice.Enabled = True + fpvt.tbAdjVol.Enabled = True + 'fpvt.tbFcPrice.Enabled = True + 'fpvt.tbFcVol.Enabled = True + Else + fpvt.opvolume.Visible = True + fpvt.opprice.Visible = True + 'fpvt.tbBasePrice.BackColor = &H80000003 + 'fpvt.tbBaseVol.BackColor = &H80000003 + fpvt.tbAdjPrice.BackColor = &H80000003 + fpvt.tbAdjVol.BackColor = &H80000003 + fpvt.tbAdjVal.BackColor = &H80000005 + fpvt.tbAdjVal.Enabled = True + 'fpvt.tbFcPrice.BackColor = &H80000003 + 'fpvt.tbFcVol.BackColor = &H80000003 + 'enabled + 'fpvt.tbBasePrice.Enabled = False + 'fpvt.tbBaseVol.Enabled = False + fpvt.tbAdjPrice.Enabled = False + fpvt.tbAdjVol.Enabled = False + 'fpvt.tbFcPrice.Enabled = False + 'fpvt.tbFcVol.Enabled = False + End If + + fpvt.Show + + End Sub @@ -73,6 +133,26 @@ errh: End Sub +Function scenario_totals(doc As String) As Object + + Dim req As New WinHttp.WinHttpRequest + Dim json As Object + Dim wr As String + + With req + '.Open "GET", "http://10.56.1.15:3000/get_pool", True + .Open "GET", "http://localhost:3000/scenario_totals", True + .SetRequestHeader "Content-Type", "application/json" + .Send doc + .WaitForResponse + wr = .ResponseText + End With + + Set json = JsonConverter.ParseJson(wr) + Set scenario_totals = json + +End Function + Sub pg_main_workset() Dim req As New WinHttp.WinHttpRequest @@ -85,7 +165,7 @@ Sub pg_main_workset() Dim res() As Variant Dim str() As String - doc = "{""quota_rep"":""13025 - JAMES REGER""}" + doc = "{""quota_rep"":""90005 - MARK WILKINSON""}" With req '.Open "GET", "http://10.56.1.15:3000/get_pool", True @@ -99,42 +179,77 @@ Sub pg_main_workset() Set json = JsonConverter.ParseJson(wr) ReDim res(json("x").Count, 32) - For i = 0 To UBound(res, 1) - 1 - res(i, 0) = json("x")(i + 1)("bill_cust_descr") - res(i, 1) = json("x")(i + 1)("billto_group") - res(i, 2) = json("x")(i + 1)("ship_cust_descr") - res(i, 3) = json("x")(i + 1)("shipto_group") - res(i, 4) = json("x")(i + 1)("quota_rep_descr") - res(i, 5) = json("x")(i + 1)("director_descr") - res(i, 6) = json("x")(i + 1)("segm") - res(i, 7) = json("x")(i + 1)("mod_chan") - res(i, 8) = json("x")(i + 1)("mod_chansub") - res(i, 9) = json("x")(i + 1)("majg_descr") - res(i, 10) = json("x")(i + 1)("ming_descr") - res(i, 11) = json("x")(i + 1)("majs_descr") - res(i, 12) = json("x")(i + 1)("mins_descr") - res(i, 13) = json("x")(i + 1)("brand") - res(i, 14) = json("x")(i + 1)("part_family") - res(i, 15) = json("x")(i + 1)("part_group") - res(i, 16) = json("x")(i + 1)("branding") - res(i, 17) = json("x")(i + 1)("color") - res(i, 18) = json("x")(i + 1)("part_descr") - res(i, 19) = json("x")(i + 1)("order_season") - res(i, 20) = json("x")(i + 1)("order_month") - res(i, 21) = json("x")(i + 1)("ship_season") - res(i, 22) = json("x")(i + 1)("ship_month") - res(i, 23) = json("x")(i + 1)("request_season") - res(i, 24) = json("x")(i + 1)("request_month") - res(i, 25) = json("x")(i + 1)("promo") - res(i, 26) = json("x")(i + 1)("version") - res(i, 27) = json("x")(i + 1)("iter") - res(i, 28) = json("x")(i + 1)("value_loc") - res(i, 29) = json("x")(i + 1)("value_usd") - res(i, 30) = json("x")(i + 1)("cost_loc") - res(i, 31) = json("x")(i + 1)("cust_usd") - res(i, 32) = json("x")(i + 1)("units") + For i = 1 To UBound(res, 1) - 1 + res(i, 0) = json("x")(i)("bill_cust_descr") + res(i, 1) = json("x")(i)("billto_group") + res(i, 2) = json("x")(i)("ship_cust_descr") + res(i, 3) = json("x")(i)("shipto_group") + res(i, 4) = json("x")(i)("quota_rep_descr") + res(i, 5) = json("x")(i)("director_descr") + res(i, 6) = json("x")(i)("segm") + res(i, 7) = json("x")(i)("mod_chan") + res(i, 8) = json("x")(i)("mod_chansub") + res(i, 9) = json("x")(i)("majg_descr") + res(i, 10) = json("x")(i)("ming_descr") + res(i, 11) = json("x")(i)("majs_descr") + res(i, 12) = json("x")(i)("mins_descr") + res(i, 13) = json("x")(i)("brand") + res(i, 14) = json("x")(i)("part_family") + res(i, 15) = json("x")(i)("part_group") + res(i, 16) = json("x")(i)("branding") + res(i, 17) = json("x")(i)("color") + res(i, 18) = json("x")(i)("part_descr") + res(i, 19) = json("x")(i)("order_season") + res(i, 20) = json("x")(i)("order_month") + res(i, 21) = json("x")(i)("ship_season") + res(i, 22) = json("x")(i)("ship_month") + res(i, 23) = json("x")(i)("request_season") + res(i, 24) = json("x")(i)("request_month") + res(i, 25) = json("x")(i)("promo") + res(i, 26) = json("x")(i)("version") + res(i, 27) = json("x")(i)("iter") + res(i, 28) = json("x")(i)("value_loc") + res(i, 29) = json("x")(i)("value_usd") + res(i, 30) = json("x")(i)("cost_loc") + res(i, 31) = json("x")(i)("cost_usd") + res(i, 32) = json("x")(i)("units") Next i + res(0, 0) = "bill_cust_descr" + res(0, 1) = "billto_group" + res(0, 2) = "ship_cust_descr" + res(0, 3) = "shipto_group" + res(0, 4) = "quota_rep_descr" + res(0, 5) = "director_descr" + res(0, 6) = "segm" + res(0, 7) = "mod_chan" + res(0, 8) = "mod_chansub" + res(0, 9) = "majg_descr" + res(0, 10) = "ming_descr" + res(0, 11) = "majs_descr" + res(0, 12) = "mins_descr" + res(0, 13) = "brand" + res(0, 14) = "part_family" + res(0, 15) = "part_group" + res(0, 16) = "branding" + res(0, 17) = "color" + res(0, 18) = "part_descr" + res(0, 19) = "order_season" + res(0, 20) = "order_month" + res(0, 21) = "ship_season" + res(0, 22) = "ship_month" + res(0, 23) = "request_season" + res(0, 24) = "request_month" + res(0, 25) = "promo" + res(0, 26) = "version" + res(0, 27) = "iter" + res(0, 28) = "value_loc" + res(0, 29) = "value_usd" + res(0, 30) = "cost_loc" + res(0, 31) = "cost_usd" + res(0, 32) = "units" + + Set json = Nothing ReDim str(UBound(res, 1), UBound(res, 2)) @@ -149,6 +264,6 @@ Sub pg_main_workset() Next j Next i - Call x.SHTp_Dump(str, "Sheet1", 1, 1, True, False) + Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32) End Sub