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

save work

Browse Source
This commit is contained in:
Trowbridge 2019-02-28 01:47:56 -05:00
parent 953bd3548f
commit 5a2dfcdf27
3 changed files with 221 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
fpvt.frm Normal file
View File

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

BIN
fpvt.frx Normal file
View File

Binary file not shown.

191
handler.bas
View File

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