add logic to build json and call api

This commit is contained in:
Trowbridge 2019-03-06 06:29:20 -05:00
parent 6794d8ff9a
commit 42fad8ab1a
3 changed files with 208 additions and 89 deletions

155
fpvt.frm
View File

@ -74,7 +74,15 @@ End Sub
Private Sub butMAdjust_Click()
Dim i As Integer
For i = 1 To 12
If month(i, 10) <> "" Then
Call handler.request_adjust(CStr(month(i, 10)))
End If
Next i
Me.Hide
End Sub
@ -505,44 +513,25 @@ Sub calc_val()
tbFcVal = Format(CDbl(tbFcVal), "#,##0")
'build json
Set adjust = JsonConverter.ParseJson("{""scneario"":" & scenario & "}")
adjust("type") = "increment"
If opPlugVol Then
adjust("vp") = "v"
Else
adjust("vp") = "p"
End If
adjust("amount") = tbAdjVal
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName
If opEditSales Then
If opPlugVol Then
adjust("type") = "scale_v"
adjust("amount") = tbAdjVal
Else
adjust("type") = "scale_p"
adjust("amount") = tbAdjVal
End If
Else
adjust("type") = "scale_vp"
adjust("qty") = tbAdjVol
adjust("amount") = tbAdjVal
End If
'print json
'tbJSON = JsonConverter.ConvertToJson(adjust)
End Sub
Sub calc_vol()
Dim pchange As Double
If IsNumeric(tbFcVol.value) And tbFcVol <> 0 Then
'price should already have been re-calculated to base + prior at this point
tbFcVal = Format(CDbl(tbFcPrice.value) * CDbl(tbFcVol.value))
'calculate percent change
'pchange = CDbl(tbFcVal.value) / (CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value))
'plug the adjustment required
tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###")
tbAdjVol = Format(tbFcVol - (CDbl(tbBaseVol) + CDbl(tbPadjVol)), "#,###")
tbAdjPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value) - ((CDbl(tbBaseVal.value) + CDbl(tbPadjVal.value)) / (CDbl(tbBaseVol.value) + CDbl(tbPadjVol.value))), "#.000")
Else
tbFcVal = 0
tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###")
tbAdjPrice = Format((tbBaseVal + tbPadjVal) / (tbBaseVol + tbPadjVol), "#.000")
tbAdjVol = Format(-CDbl(tbBaseVol.value) - CDbl(tbPadjVol.value), "#,###")
End If
tbFcVal = Format(tbFcVal, "#,###")
tbAPI = JsonConverter.ConvertToJson(adjust)
End Sub
@ -558,12 +547,34 @@ Sub calc_price()
tbAdjVal = Format(CDbl(tbFcVal.value) - CDbl(tbBaseVal.value) - CDbl(tbPadjVal.value), "#,###")
End If
'build json
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName
If opEditSales Then
If opPlugVol Then
adjust("type") = "scale_v"
adjust("amount") = tbAdjVal
Else
adjust("type") = "scale_p"
adjust("amount") = tbAdjVal
End If
Else
adjust("type") = "scale_vp"
adjust("qty") = tbAdjVol
adjust("amount") = tbAdjVal
End If
'print json
tbAPI = JsonConverter.ConvertToJson(adjust)
End Sub
Sub calc_mval()
Dim pchange As Double
Dim j As Object
If IsNumeric(tbMFVal.value) Then
'get textbox value
@ -592,6 +603,42 @@ Sub calc_mval()
End If
tbMFVal = Format(tbMFVal, "#,###")
'build json
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
j("user") = Application.UserName
If opEditSalesM Then
If opmvol Then
If nomonth Then
j("type") = "addmonth_v"
j("month") = month(mline, 0)
Else
j("type") = "scale_v"
End If
j("amount") = aValm
Else
If nomonth Then
j("type") = "addmonth_p"
j("month") = month(mline, 0)
Else
j("type") = "scale_p"
End If
j("amount") = aValm
End If
Else
If nomonth Then
j("type") = "addmonth_vp"
j("month") = month(mline, 0)
Else
j("type") = "scale_vp"
End If
j("qty") = aVolm
j("amount") = aValm
End If
month(mline, 10) = JsonConverter.ConvertToJson(j)
tbAPI = JsonConverter.ConvertToJson(j)
Me.load_mbox
Me.load_array
@ -599,6 +646,8 @@ End Sub
Sub calc_mprice()
Dim j As Object
If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then
'capture currently changed item
fVolm = tbMFVol.value
@ -617,6 +666,44 @@ Sub calc_mprice()
aValm = fValm - bValm - pValm
End If
'build json
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
j("user") = Application.UserName
If opEditSalesM Then
If opmvol Then
If nomonth Then
j("type") = "addmonth_v"
j("month") = month(mline, 0)
Else
j("type") = "scale_v"
End If
j("amount") = aValm
Else
If nomonth Then
'this scenario should be prevented
j("type") = "addmonth_v"
j("month") = month(mline, 0)
Else
j("type") = "scale_p"
End If
j("amount") = aValm
End If
Else
If nomonth Then
j("type") = "addmonth_vp"
j("month") = month(mline, 0)
Else
j("type") = "scale_vp"
End If
j("qty") = aVolm
j("amount") = aValm
End If
month(mline, 10) = JsonConverter.ConvertToJson(j)
tbAPI = JsonConverter.ConvertToJson(j)
If clear_lb Then MsgBox ("clear")
Me.load_mbox
Me.load_array

BIN
fpvt.frx

Binary file not shown.

View File

@ -40,61 +40,6 @@ Sub load_fpvt()
End Sub
Function request_adjust(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/scenario_totals", True
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
.Open "GET", "http://localhost:3000/request_adjust", True
.SetRequestHeader "Content-Type", "application/json"
.Send doc
.WaitForResponse
wr = .ResponseText
End With
Set json = JsonConverter.ParseJson(wr)
Set scenario_totals = json
End Function
Function scenario_totals(doc As String, ByRef status As Boolean) As Object
Dim req As New WinHttp.WinHttpRequest
Dim json As Object
Dim wr As String
On Error GoTo errh
With req
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
.Open "GET", "http://10.56.1.15:3000/scenario_totals", 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
errh:
If Err.Number <> 0 Then
status = False
MsgBox (Err.Description)
Set scenario_totals = Nothing
Else
status = True
End If
End Function
Function scenario_package(doc As String, ByRef status As Boolean) As Object
Dim req As New WinHttp.WinHttpRequest
@ -236,6 +181,7 @@ Sub pg_main_workset(rep As String)
Next i
Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32)
End Sub
@ -268,3 +214,89 @@ Sub test()
End Sub
Function request_adjust(doc As String) As Object
Dim req As New WinHttp.WinHttpRequest
Dim json As Object
Dim wr As String
Dim i As Integer
Dim j As Integer
Dim str() As String
Set json = JsonConverter.ParseJson(doc)
With req
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
'.Open "GET", "http://10.56.1.15:3000/scenario_totals", True
.Open "GET", "http://192.168.1.69:3000/" & json("type"), True
.SetRequestHeader "Content-Type", "application/json"
.Send doc
.WaitForResponse
wr = .ResponseText
End With
Set json = JsonConverter.ParseJson(wr)
ReDim res(json("x").Count - 1, 32)
For i = 1 To UBound(res, 1) + 1
res(i - 1, 0) = json("x")(i)("bill_cust_descr")
res(i - 1, 1) = json("x")(i)("billto_group")
res(i - 1, 2) = json("x")(i)("ship_cust_descr")
res(i - 1, 3) = json("x")(i)("shipto_group")
res(i - 1, 4) = json("x")(i)("quota_rep_descr")
res(i - 1, 5) = json("x")(i)("director_descr")
res(i - 1, 6) = json("x")(i)("segm")
res(i - 1, 7) = json("x")(i)("mod_chan")
res(i - 1, 8) = json("x")(i)("mod_chansub")
res(i - 1, 9) = json("x")(i)("majg_descr")
res(i - 1, 10) = json("x")(i)("ming_descr")
res(i - 1, 11) = json("x")(i)("majs_descr")
res(i - 1, 12) = json("x")(i)("mins_descr")
res(i - 1, 13) = json("x")(i)("brand")
res(i - 1, 14) = json("x")(i)("part_family")
res(i - 1, 15) = json("x")(i)("part_group")
res(i - 1, 16) = json("x")(i)("branding")
res(i - 1, 17) = json("x")(i)("color")
res(i - 1, 18) = json("x")(i)("part_descr")
res(i - 1, 19) = json("x")(i)("order_season")
res(i - 1, 20) = json("x")(i)("order_month")
res(i - 1, 21) = json("x")(i)("ship_season")
res(i - 1, 22) = json("x")(i)("ship_month")
res(i - 1, 23) = json("x")(i)("request_season")
res(i - 1, 24) = json("x")(i)("request_month")
res(i - 1, 25) = json("x")(i)("promo")
res(i - 1, 26) = json("x")(i)("version")
res(i - 1, 27) = json("x")(i)("iter")
res(i - 1, 28) = json("x")(i)("value_loc")
res(i - 1, 29) = json("x")(i)("value_usd")
res(i - 1, 30) = json("x")(i)("cost_loc")
res(i - 1, 31) = json("x")(i)("cost_usd")
res(i - 1, 32) = json("x")(i)("units")
Next i
Set json = Nothing
ReDim str(UBound(res, 1), UBound(res, 2))
For i = 0 To UBound(res, 1)
For j = 0 To UBound(res, 2)
If IsNull(res(i, j)) Then
str(i, j) = ""
Else
str(i, j) = res(i, j)
End If
Next j
Next i
Do Until Sheets("data").Cells(i, 1) = ""
i = i + 1
Loop
Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
End Function