2454393a1d
Instead of having multiple locations with the same code, the web interface code now lives in its own module, and is called from multiple locations.
469 lines
15 KiB
QBasic
469 lines
15 KiB
QBasic
Attribute VB_Name = "handler"
|
|
Option Explicit
|
|
|
|
Public sql As String
|
|
Public jsql As String
|
|
Public scenario As String
|
|
Public sc() As Variant
|
|
Public data() As String
|
|
Public agg() As String
|
|
Public showprice As Boolean
|
|
Public server As String
|
|
Public plan As String
|
|
Public basis() As Variant
|
|
Public baseline() As Variant
|
|
Public adjust() As Variant
|
|
|
|
|
|
Sub load_fpvt()
|
|
|
|
Application.StatusBar = "retrieving selection data....."
|
|
|
|
Dim i As Long
|
|
Dim s_tot As Object
|
|
|
|
fpvt.lbSDET.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
|
|
|
|
|
|
fpvt.Show
|
|
|
|
|
|
|
|
End Sub
|
|
|
|
Function scenario_package(doc As String, ByRef errorMsg As String) As Object
|
|
Set scenario_package = makeHttpRequest("GET", "scenario_package", doc, errorMsg)
|
|
End Function
|
|
|
|
Sub pg_main_workset(catg As String, rep As String)
|
|
Dim errorMsg As String
|
|
Application.StatusBar = "Querying for " & rep & "'s pool of data..."
|
|
|
|
Dim json As Object
|
|
Set json = makeHttpRequest("GET", "get_pool", "{""scenario"":{""" & catg & """:""" & rep & """}}", errorMsg)
|
|
|
|
If errorMsg <> "" Then
|
|
MsgBox errorMsg, vbOKOnly + vbExclamation, "Couldn't " & rep & "'s pool of data."
|
|
Exit Sub
|
|
End If
|
|
|
|
ReDim res(0, 34)
|
|
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"
|
|
res(0, 6) = "segm"
|
|
res(0, 7) = "substance"
|
|
res(0, 8) = "chan"
|
|
res(0, 9) = "chansub"
|
|
res(0, 10) = "part_descr"
|
|
res(0, 11) = "part_group"
|
|
res(0, 12) = "branding"
|
|
res(0, 13) = "majg_descr"
|
|
res(0, 14) = "ming_descr"
|
|
res(0, 15) = "majs_descr"
|
|
res(0, 16) = "mins_descr"
|
|
res(0, 17) = "order_season"
|
|
res(0, 18) = "order_month"
|
|
res(0, 19) = "ship_season"
|
|
res(0, 20) = "ship_month"
|
|
res(0, 21) = "request_season"
|
|
res(0, 22) = "request_month"
|
|
res(0, 23) = "promo"
|
|
res(0, 24) = "value_loc"
|
|
res(0, 25) = "value_usd"
|
|
res(0, 26) = "cost_loc"
|
|
res(0, 27) = "cost_usd"
|
|
res(0, 28) = "units"
|
|
res(0, 29) = "version"
|
|
res(0, 30) = "iter"
|
|
res(0, 31) = "logid"
|
|
res(0, 32) = "tag"
|
|
res(0, 33) = "comment"
|
|
res(0, 34) = "pounds"
|
|
|
|
shData.Cells.ClearContents
|
|
Call Utils.SHTp_DumpVar(res, shData.Name, 1, 1, False, True, True)
|
|
|
|
Dim batchSize As Integer
|
|
batchSize = 1000
|
|
Dim totalRows As Long
|
|
totalRows = json("x").Count
|
|
Dim jsonRow As Long
|
|
jsonRow = 1
|
|
Dim sheetRow As Long
|
|
sheetRow = 2
|
|
Dim arrayRow As Long
|
|
|
|
' While the JSON array still has rows,
|
|
' 1. move the 1st one to a VBA 2-D array, deleting it from the JSON array.
|
|
' 2. When 1000 have been copied, put the values onto the worksheet, and
|
|
' empty the VBA array.
|
|
' Splitting the JSON array into smaller batches when creating the VBA array
|
|
' means there is less memory needed for the operation.
|
|
Do While json("x").Count > 0
|
|
If jsonRow Mod batchSize = 1 Then
|
|
ReDim res(batchSize - 1, 34)
|
|
arrayRow = 0
|
|
End If
|
|
res(arrayRow, 0) = json("x")(1)("bill_cust_descr")
|
|
res(arrayRow, 1) = json("x")(1)("billto_group")
|
|
res(arrayRow, 2) = json("x")(1)("ship_cust_descr")
|
|
res(arrayRow, 3) = json("x")(1)("shipto_group")
|
|
res(arrayRow, 4) = json("x")(1)("quota_rep_descr")
|
|
res(arrayRow, 5) = json("x")(1)("director")
|
|
res(arrayRow, 6) = json("x")(1)("segm")
|
|
res(arrayRow, 7) = json("x")(1)("substance")
|
|
res(arrayRow, 8) = json("x")(1)("chan")
|
|
res(arrayRow, 9) = json("x")(1)("chansub")
|
|
res(arrayRow, 10) = json("x")(1)("part_descr")
|
|
res(arrayRow, 11) = json("x")(1)("part_group")
|
|
res(arrayRow, 12) = json("x")(1)("branding")
|
|
res(arrayRow, 13) = json("x")(1)("majg_descr")
|
|
res(arrayRow, 14) = json("x")(1)("ming_descr")
|
|
res(arrayRow, 15) = json("x")(1)("majs_descr")
|
|
res(arrayRow, 16) = json("x")(1)("mins_descr")
|
|
res(arrayRow, 17) = json("x")(1)("order_season")
|
|
res(arrayRow, 18) = json("x")(1)("order_month")
|
|
res(arrayRow, 19) = json("x")(1)("ship_season")
|
|
res(arrayRow, 20) = json("x")(1)("ship_month")
|
|
res(arrayRow, 21) = json("x")(1)("request_season")
|
|
res(arrayRow, 22) = json("x")(1)("request_month")
|
|
res(arrayRow, 23) = json("x")(1)("promo")
|
|
res(arrayRow, 24) = json("x")(1)("value_loc")
|
|
res(arrayRow, 25) = json("x")(1)("value_usd")
|
|
res(arrayRow, 26) = json("x")(1)("cost_loc")
|
|
res(arrayRow, 27) = json("x")(1)("cost_usd")
|
|
res(arrayRow, 28) = json("x")(1)("units")
|
|
res(arrayRow, 29) = json("x")(1)("version")
|
|
res(arrayRow, 30) = json("x")(1)("iter")
|
|
res(arrayRow, 31) = json("x")(1)("logid")
|
|
res(arrayRow, 32) = json("x")(1)("tag")
|
|
res(arrayRow, 33) = json("x")(1)("comment")
|
|
res(arrayRow, 34) = json("x")(1)("pounds")
|
|
json("x").Remove 1
|
|
arrayRow = arrayRow + 1
|
|
If jsonRow Mod batchSize = 0 Or json("x").Count = 0 Then
|
|
Application.StatusBar = "Populating spreadsheet: " & Format(jsonRow, "#,##0") & " of " & Format(totalRows, "#,##0") & " rows..."
|
|
Call Utils.SHTp_DumpVar(res, shData.Name, sheetRow, 1, False, True, True)
|
|
sheetRow = sheetRow + batchSize
|
|
End If
|
|
jsonRow = jsonRow + 1
|
|
Loop
|
|
|
|
Set json = Nothing
|
|
Application.StatusBar = False
|
|
End Sub
|
|
|
|
Sub pull_rep()
|
|
openf.Show
|
|
End Sub
|
|
|
|
|
|
|
|
Sub request_adjust(doc As String, ByRef errorMsg As String)
|
|
Dim json As Object
|
|
Set json = JsonConverter.ParseJson(doc)
|
|
Set json = makeHttpRequest("POST", json("type"), doc, errorMsg)
|
|
|
|
If errorMsg <> "" Then
|
|
Exit Sub
|
|
End If
|
|
|
|
ReDim res(json("x").Count - 1, 34)
|
|
|
|
Dim i As Long
|
|
For i = 0 To UBound(res, 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")
|
|
res(i, 6) = json("x")(i + 1)("segm")
|
|
res(i, 7) = json("x")(i + 1)("substance")
|
|
res(i, 8) = json("x")(i + 1)("chan")
|
|
res(i, 9) = json("x")(i + 1)("chansub")
|
|
res(i, 10) = json("x")(i + 1)("part_descr")
|
|
res(i, 11) = json("x")(i + 1)("part_group")
|
|
res(i, 12) = json("x")(i + 1)("branding")
|
|
res(i, 13) = json("x")(i + 1)("majg_descr")
|
|
res(i, 14) = json("x")(i + 1)("ming_descr")
|
|
res(i, 15) = json("x")(i + 1)("majs_descr")
|
|
res(i, 16) = json("x")(i + 1)("mins_descr")
|
|
res(i, 17) = json("x")(i + 1)("order_season")
|
|
res(i, 18) = json("x")(i + 1)("order_month")
|
|
res(i, 19) = json("x")(i + 1)("ship_season")
|
|
res(i, 20) = json("x")(i + 1)("ship_month")
|
|
res(i, 21) = json("x")(i + 1)("request_season")
|
|
res(i, 22) = json("x")(i + 1)("request_month")
|
|
res(i, 23) = json("x")(i + 1)("promo")
|
|
res(i, 24) = json("x")(i + 1)("value_loc")
|
|
res(i, 25) = json("x")(i + 1)("value_usd")
|
|
res(i, 26) = json("x")(i + 1)("cost_loc")
|
|
res(i, 27) = json("x")(i + 1)("cost_usd")
|
|
res(i, 28) = json("x")(i + 1)("units")
|
|
res(i, 29) = json("x")(i + 1)("version")
|
|
res(i, 30) = json("x")(i + 1)("iter")
|
|
res(i, 31) = json("x")(i + 1)("logid")
|
|
res(i, 32) = json("x")(i + 1)("tag")
|
|
res(i, 33) = json("x")(i + 1)("comment")
|
|
res(i, 34) = json("x")(i + 1)("pounds")
|
|
Next i
|
|
|
|
errorMsg = ""
|
|
|
|
i = shData.UsedRange.Rows.Count + 1
|
|
Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
|
|
shOrders.PivotTables("ptOrders").PivotCache.Refresh
|
|
|
|
End Sub
|
|
|
|
Sub load_config()
|
|
|
|
Dim i As Integer
|
|
'----server to use---------------------------------------------------------
|
|
handler.server = shConfig.Range("server").Value
|
|
'---basis------------------------------------------------------------------
|
|
With shConfig.ListObjects("BASIS")
|
|
For i = 1 To .DataBodyRange.Rows.Count
|
|
ReDim Preserve handler.basis(i - 1)
|
|
handler.basis(i - 1) = .DataBodyRange(i, 1)
|
|
Next
|
|
End With
|
|
'---baseline-----------------------------------------------------------------
|
|
With shConfig.ListObjects("BASELINE")
|
|
For i = 1 To .DataBodyRange.Rows.Count
|
|
ReDim Preserve handler.baseline(i - 1)
|
|
handler.baseline(i - 1) = .DataBodyRange(i, 1)
|
|
Next
|
|
End With
|
|
'---adjustments-----------------------------------------------------------------
|
|
With shConfig.ListObjects("ADJUST")
|
|
For i = 1 To .DataBodyRange.Rows.Count
|
|
ReDim Preserve handler.adjust(i - 1)
|
|
handler.adjust(i - 1) = .DataBodyRange(i, 1)
|
|
Next
|
|
End With
|
|
'---plan version--------------------------------------------------------------
|
|
handler.plan = shConfig.Range("budget").Value
|
|
|
|
End Sub
|
|
|
|
Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
|
|
|
Dim j As Object
|
|
Dim i As Integer
|
|
Dim r As Long
|
|
|
|
With shMonthUpdate
|
|
|
|
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
|
.Cells(1, 16) = JsonConverter.ConvertToJson(j)
|
|
|
|
For i = 1 To 12
|
|
'------------volume-------------------
|
|
.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
|
|
.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
|
|
.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
|
|
.Cells(i + 1, 4) = 0
|
|
.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
|
|
|
|
'------------value----------------------
|
|
.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
|
|
.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
|
|
.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
|
|
.Cells(i + 1, 14) = 0
|
|
.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
|
|
|
|
'-------------price----------------------
|
|
If i > 0 Then
|
|
'--prior--
|
|
If co_num(pkg(i, 1), 0) = 0 Then
|
|
.Cells(i + 1, 6) = 0
|
|
Else
|
|
.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
|
|
End If
|
|
|
|
'--base--
|
|
If co_num(pkg(i, 2), 0) = 0 Then
|
|
'if there is no monthly base volume,
|
|
'then use the prior price, if there was no prior price,
|
|
'then inherit the average price for the year before current adjustments
|
|
If .Cells(i, 7) <> 0 Then
|
|
.Cells(i + 1, 7) = .Cells(i, 7)
|
|
Else
|
|
If pkg(13, 1) + pkg(13, 2) = 0 Then
|
|
.Cells(i + 1, 7) = 0
|
|
Else
|
|
.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
|
|
End If
|
|
End If
|
|
Else
|
|
.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
|
|
End If
|
|
|
|
'--adjust--
|
|
If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
|
|
.Cells(i + 1, 8) = 0
|
|
Else
|
|
.Cells(i + 1, 8) = (Round(pkg(i, 7), 10) + Round(pkg(i, 6), 10)) / (Round(pkg(i, 3), 10) + Round(pkg(i, 2), 10)) - (Round(pkg(i, 6), 10) / Round(pkg(i, 2), 10))
|
|
End If
|
|
|
|
'--current adjust--
|
|
.Cells(i + 1, 9) = 0
|
|
|
|
'--forecast--
|
|
If co_num(pkg(i, 4), 0) = 0 Then
|
|
'if there is no monthly base volume,
|
|
'then use the prior price, if there was no prior price,
|
|
'then inherit the average price for the year before current adjustments
|
|
If .Cells(i, 10) <> 0 Then
|
|
.Cells(i + 1, 10) = .Cells(i, 10)
|
|
Else
|
|
If pkg(13, 1) + pkg(13, 2) = 0 Then
|
|
.Cells(i + 1, 10) = 0
|
|
Else
|
|
.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
|
|
End If
|
|
End If
|
|
Else
|
|
.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
|
|
End If
|
|
|
|
End If
|
|
|
|
Next i
|
|
|
|
'scenario
|
|
.Range("R1:S1000").ClearContents
|
|
For i = 0 To UBound(handler.sc, 1)
|
|
.Cells(i + 1, 18) = handler.sc(i, 0)
|
|
.Cells(i + 1, 19) = handler.sc(i, 1)
|
|
Next i
|
|
|
|
'basket
|
|
.Range("U1:AC100000").ClearContents
|
|
Call Utils.SHTp_DumpVar(basket, .Name, 1, 21, False, False, True)
|
|
Call Utils.SHTp_DumpVar(basket, .Name, 1, 26, False, False, True)
|
|
shConfig.Range("rebuild").Value = 0
|
|
shConfig.Range("show_basket").Value = 0
|
|
shConfig.Range("new_part").Value = 0
|
|
|
|
shMonthView.LoadSheet
|
|
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
|
|
|
|
If one = "" Or IsNull(one) Then
|
|
co_num = two
|
|
Else
|
|
co_num = one
|
|
End If
|
|
|
|
End Function
|
|
|
|
|
|
Function list_changes(doc As String, ByRef errorMsg As String) As Variant()
|
|
Dim json As Object
|
|
Set json = makeHttpRequest("GET", "list_changes", doc, errorMsg)
|
|
|
|
If errorMsg <> "" Then
|
|
Exit Function
|
|
End If
|
|
|
|
ReDim res(json("x").Count - 1, 7)
|
|
|
|
Dim i As Long
|
|
For i = 0 To UBound(res, 1)
|
|
res(i, 0) = json("x")(i + 1)("user")
|
|
res(i, 1) = json("x")(i + 1)("quota_rep_descr")
|
|
res(i, 2) = json("x")(i + 1)("stamp")
|
|
res(i, 3) = json("x")(i + 1)("tag")
|
|
res(i, 4) = json("x")(i + 1)("comment")
|
|
res(i, 5) = json("x")(i + 1)("sales")
|
|
res(i, 6) = json("x")(i + 1)("id")
|
|
res(i, 7) = json("x")(i + 1)("doc")
|
|
Next i
|
|
|
|
list_changes = res
|
|
|
|
End Function
|
|
|
|
Sub undo_changes(ByVal logid As Integer, ByRef errorMsg As String)
|
|
Dim json As Object
|
|
Set json = makeHttpRequest("GET", "undo_change", "{""logid"":" & logid & "}", errorMsg)
|
|
|
|
logid = json("x")(1)("id")
|
|
|
|
'---------loop through and get a list of each row that needs deleted?-----
|
|
|
|
Dim i As Long
|
|
Dim j As Long
|
|
j = 0
|
|
For i = 1 To 100
|
|
If shData.Cells(1, i) = "logid" Then
|
|
j = i
|
|
Exit For
|
|
End If
|
|
Next i
|
|
|
|
If j = 0 Then
|
|
errorMsg = "Current data set is not tracking changes. Cannot isolate change locally."
|
|
Exit Sub
|
|
End If
|
|
|
|
i = 2
|
|
With shData
|
|
While .Cells(i, 1) <> ""
|
|
If .Cells(i, j) = logid Then
|
|
.Rows(i).Delete
|
|
Else
|
|
i = i + 1
|
|
End If
|
|
Wend
|
|
End With
|
|
|
|
End Sub
|
|
|
|
|
|
Sub history()
|
|
changes.Show
|
|
End Sub
|
|
|
|
Function get_swap_fit(doc As String, ByRef errorMsg As String) As Variant()
|
|
Dim json As Object
|
|
Set json = makeHttpRequest("GET", "swap_fit", doc, errorMsg)
|
|
|
|
Dim res() As Variant
|
|
ReDim res(json("x").Count - 1, 3)
|
|
|
|
Dim i As Integer
|
|
For i = 0 To UBound(res, 1)
|
|
res(i, 0) = json("x")(i + 1)("part")
|
|
res(i, 1) = json("x")(i + 1)("value_usd")
|
|
res(i, 2) = json("x")(i + 1)("swap")
|
|
res(i, 3) = json("x")(i + 1)("fit")
|
|
Next i
|
|
|
|
get_swap_fit = res
|
|
|
|
End Function
|
|
|
|
|
|
|