save work
This commit is contained in:
Trowbridge
parent
678c0cafc9
commit
85c3269bcc
154
fpvt.frm
154
fpvt.frm
@ -1,10 +1,10 @@
|
||||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
|
||||
Caption = "Forecast Adjustment"
|
||||
ClientHeight = 7275
|
||||
ClientHeight = 7260
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 13695
|
||||
ClientWidth = 16140
|
||||
OleObjectBlob = "fpvt.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
@ -14,11 +14,10 @@ Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Public mod_adjust As Boolean
|
||||
Public month() As Variant
|
||||
Private month() As Variant
|
||||
Private mload() As Variant
|
||||
Option Explicit
|
||||
|
||||
|
||||
|
||||
Private Sub cbCancel_Click()
|
||||
|
||||
tbAdjVol.value = 0
|
||||
@ -45,6 +44,73 @@ Private Sub chbPlug_Change()
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub lbMonth_Change()
|
||||
|
||||
Dim i As Long
|
||||
For i = 0 To 12
|
||||
If lbMonth.Selected(i) Then
|
||||
If i <> 0 Then
|
||||
'------------base-------------------------------------
|
||||
tbMBaseVal.value = co_num(month(i, 6), 0)
|
||||
tbMBaseVol.value = co_num(month(i, 2), 0)
|
||||
tbmPAVal.value = co_num(month(i, 7), 0)
|
||||
tbMPAVol.value = co_num(month(i, 3), 0)
|
||||
tbMFVal.value = co_num(month(i, 8), 0)
|
||||
tbMFVol.value = co_num(month(i, 4), 0)
|
||||
If tbMBaseVol <> 0 Then
|
||||
tbMBasePrice = Format(tbMBaseVal / tbMBaseVol, "#.000")
|
||||
Else
|
||||
tbMBasePrice = 0
|
||||
End If
|
||||
If tbMFVol <> 0 Then
|
||||
tbMFPrice = Format(tbMFVal / tbMFVol, "#.000")
|
||||
Else
|
||||
tbMFPrice = 0
|
||||
End If
|
||||
Else
|
||||
tbMBaseVal.value = 0
|
||||
tbMBaseVol.value = 0
|
||||
tbmPAVal.value = 0
|
||||
tbMPAVol.value = 0
|
||||
tbMFVal.value = 0
|
||||
tbMFVol.value = 0
|
||||
tbMBasePrice = 0
|
||||
tbMFPrice = 0
|
||||
End If
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub ListBox1_Click()
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub opmprice_Click()
|
||||
|
||||
tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###")
|
||||
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
|
||||
tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub opmvol_Click()
|
||||
|
||||
Dim pchange As Double
|
||||
|
||||
'---------calculate percent change----------------------------------------------------------------------
|
||||
pchange = 1 + CDbl(tbMAVal.value) / (CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value))
|
||||
'---------add the adjustments together to get the new forecast------------------------------------------
|
||||
tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###")
|
||||
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###")
|
||||
tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub opprice_Click()
|
||||
|
||||
tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value) + CDbl(tbAdjVal.value), "#,###")
|
||||
@ -101,12 +167,41 @@ Private Sub tbAdjVol_Change()
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub tbMAVal_Change()
|
||||
|
||||
Dim pchange As Double
|
||||
|
||||
If IsNumeric(tbMAVal.value) Then
|
||||
'---------calculate percent change----------------------------------------------------------------------
|
||||
pchange = 1 + CDbl(tbMAVal.value) / (CDbl(tbMAVal.value) + CDbl(tbMBaseVal.value))
|
||||
'---------add the adjustments together to get the new forecast------------------------------------------
|
||||
tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###")
|
||||
'---------if volume adjustment method is selected, scale the volume up----------------------------------
|
||||
If opmvol Then
|
||||
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###")
|
||||
Else
|
||||
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
|
||||
End If
|
||||
tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
|
||||
Else
|
||||
tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value), "#,###")
|
||||
tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###")
|
||||
tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000")
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub UserForm_Activate()
|
||||
|
||||
Dim sp As Object
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim k As Long
|
||||
Dim ok As Boolean
|
||||
|
||||
handler.server = "http://10.56.1.20:3000"
|
||||
'handler.server = "http://192.168.1.69:3000"
|
||||
|
||||
Set sp = handler.scenario_package(handler.scenario, ok)
|
||||
|
||||
If Not ok Then
|
||||
@ -142,10 +237,59 @@ Private Sub UserForm_Activate()
|
||||
|
||||
'---------------------------------------populate monthly-------------------------------------------------------
|
||||
|
||||
k = 0
|
||||
'--parse json into variant array for loading--
|
||||
ReDim month(sp("package")("mpvt").Count, 8)
|
||||
|
||||
For i = 1 To sp("package")("mpvt").Count
|
||||
month(i, 0) = sp("package")("mpvt")(i)("order_month")
|
||||
month(i, 1) = Format(sp("package")("mpvt")(i)("2019 qty"), "#,###")
|
||||
month(i, 2) = Format(sp("package")("mpvt")(i)("2020 base qty"), "#,###")
|
||||
month(i, 3) = Format(sp("package")("mpvt")(i)("2020 adj qty"), "#,###")
|
||||
month(i, 4) = Format(sp("package")("mpvt")(i)("2020 tot qty"), "#,###")
|
||||
month(i, 5) = Format(sp("package")("mpvt")(i)("2019 value_usd"), "#,###")
|
||||
month(i, 6) = Format(sp("package")("mpvt")(i)("2020 base value_usd"), "#,###")
|
||||
month(i, 7) = Format(sp("package")("mpvt")(i)("2020 adj value_usd"), "#,###")
|
||||
month(i, 8) = Format(sp("package")("mpvt")(i)("2020 tot value_usd"), "#,###")
|
||||
|
||||
Next i
|
||||
|
||||
|
||||
month(0, 0) = "month"
|
||||
month(0, 1) = "2019 qty"
|
||||
month(0, 2) = "2020 base qty"
|
||||
month(0, 3) = "2020 adj qty"
|
||||
month(0, 4) = "2020 qty"
|
||||
month(0, 5) = "2019 val"
|
||||
month(0, 6) = "2020 base val"
|
||||
month(0, 7) = "2020 adj val"
|
||||
month(0, 8) = "2020 val"
|
||||
|
||||
ReDim mload(UBound(month, 1), 5)
|
||||
For i = 0 To UBound(month, 1)
|
||||
mload(i, 0) = month(i, 0)
|
||||
mload(i, 1) = month(i, 1)
|
||||
mload(i, 2) = month(i, 4)
|
||||
mload(i, 3) = month(i, 5)
|
||||
mload(i, 4) = month(i, 8)
|
||||
Next i
|
||||
|
||||
lbMonth.list = mload
|
||||
lbMonth.ColumnCount = 8
|
||||
|
||||
'MsgBox (lbMonth.list(0, 0))
|
||||
|
||||
Application.StatusBar = False
|
||||
|
||||
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
|
||||
|
||||
|
||||
186
handler.bas
186
handler.bas
@ -9,11 +9,12 @@ Public wapi As New Windows_API
|
||||
Public data() As String
|
||||
Public agg() As String
|
||||
Public showprice As Boolean
|
||||
Public server As String
|
||||
|
||||
|
||||
Sub load_fpvt()
|
||||
|
||||
fpvt.sbEdit.SimpleText = "retrieving data.........."
|
||||
Application.StatusBar = "retrieving selection 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))
|
||||
@ -34,39 +35,21 @@ Sub load_fpvt()
|
||||
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
|
||||
|
||||
|
||||
@ -78,70 +61,16 @@ Sub load_fpvt()
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub pull_months(doc As String)
|
||||
|
||||
Dim req As New WinHttp.WinHttpRequest
|
||||
Dim wapi As New Windows_API
|
||||
Dim wr As String
|
||||
Dim json As Object
|
||||
Dim i As Long
|
||||
|
||||
|
||||
|
||||
With req
|
||||
'.Open "GET", "http://10.56.1.108:3000/monthly_orders", True
|
||||
.Open "GET", "http://192.168.1.69:3000/monthly_orders", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
End With
|
||||
|
||||
Call wapi.ClipBoard_SetData(wr)
|
||||
|
||||
'MsgBox (wr)
|
||||
|
||||
On Error GoTo jerr
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
|
||||
jerr:
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox ("function call error:" & vbCrLf & wr)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
On Error GoTo errh
|
||||
|
||||
Sheets("test").range("A2:D1000").ClearContents
|
||||
Sheets("test").range("N3:Q14").ClearContents
|
||||
|
||||
For i = 1 To json("jsonb_agg").Count
|
||||
Sheets("test").Cells(i + 1, 1) = json("jsonb_agg")(i)("oseas")
|
||||
Sheets("test").Cells(i + 1, 2) = json("jsonb_agg")(i)("monthn")
|
||||
Sheets("test").Cells(i + 1, 3) = json("jsonb_agg")(i)("qty")
|
||||
Sheets("test").Cells(i + 1, 4) = json("jsonb_agg")(i)("sales")
|
||||
Next i
|
||||
|
||||
Sheets("test").Select
|
||||
|
||||
errh:
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox (Err.Description)
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Function scenario_totals(doc As String) As Object
|
||||
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/get_pool", True
|
||||
.Open "GET", "http://localhost:3000/scenario_totals", True
|
||||
'.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
|
||||
@ -153,7 +82,71 @@ Function scenario_totals(doc As String) As Object
|
||||
|
||||
End Function
|
||||
|
||||
Sub pg_main_workset()
|
||||
|
||||
|
||||
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
|
||||
Dim json As Object
|
||||
Dim wr As String
|
||||
|
||||
On Error GoTo errh
|
||||
|
||||
With req
|
||||
.Open "GET", server & "/scenario_package", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
End With
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
Set scenario_package = json
|
||||
|
||||
errh:
|
||||
If Err.Number <> 0 Then
|
||||
status = False
|
||||
MsgBox (Err.Description)
|
||||
Set scenario_package = Nothing
|
||||
Else
|
||||
status = True
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Sub pg_main_workset(rep As String)
|
||||
|
||||
Dim req As New WinHttp.WinHttpRequest
|
||||
Dim wapi As New Windows_API
|
||||
@ -165,11 +158,10 @@ Sub pg_main_workset()
|
||||
Dim res() As Variant
|
||||
Dim str() As String
|
||||
|
||||
doc = "{""quota_rep"":""90005 - MARK WILKINSON""}"
|
||||
doc = "{""quota_rep"":""" & rep & """}"
|
||||
|
||||
With req
|
||||
'.Open "GET", "http://10.56.1.15:3000/get_pool", True
|
||||
.Open "GET", "http://192.168.1.69:3000/get_pool", True
|
||||
.Open "GET", server & "/get_pool", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send doc
|
||||
.WaitForResponse
|
||||
@ -179,7 +171,7 @@ Sub pg_main_workset()
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
ReDim res(json("x").Count, 32)
|
||||
|
||||
For i = 1 To UBound(res, 1) - 1
|
||||
For i = 1 To UBound(res, 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")
|
||||
@ -267,3 +259,33 @@ Sub pg_main_workset()
|
||||
Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32)
|
||||
|
||||
End Sub
|
||||
|
||||
Sub pull_rep()
|
||||
|
||||
openf.Show
|
||||
|
||||
End Sub
|
||||
|
||||
Sub test()
|
||||
|
||||
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_package", True
|
||||
.Open "GET", "http://localhost:3000/scenario_package", True
|
||||
.SetRequestHeader "Content-Type", "application/json"
|
||||
.Send handler.scenario
|
||||
.WaitForResponse
|
||||
wr = .ResponseText
|
||||
End With
|
||||
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
'Set scenario_totals = json
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
41
pivot.bas
41
pivot.bas
@ -1,8 +1,8 @@
|
||||
Option Explicit
|
||||
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean)
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||
|
||||
If Intersect(Target, ActiveSheet.range("b11:v100000")) Is Nothing Then
|
||||
If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
@ -12,7 +12,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
Cancel = True
|
||||
|
||||
Dim i As Long
|
||||
@ -31,9 +30,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean
|
||||
Dim pi As PivotItem
|
||||
Dim wapi As New Windows_API
|
||||
|
||||
|
||||
|
||||
|
||||
Set ri = Target.Cells.PivotCell.RowItems
|
||||
Set ci = Target.Cells.PivotCell.ColumnItems
|
||||
Set df = Target.Cells.PivotCell.DataField
|
||||
@ -55,44 +51,13 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean
|
||||
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
|
||||
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
|
||||
handler.sc(i - 1, 1) = ri(i).Name
|
||||
'the following looks for filtered items, but this is redundant because a single one has been isolated
|
||||
'For Each pi In pt.PivotFields(piv_fld_index(rd(i).Name, pt)).PivotItems
|
||||
' If Not pi.Visible Then
|
||||
' sql = sql & vbCrLf & "AND " & rd(i).Name & " <> '" & pi.Name & "'"
|
||||
' End If
|
||||
'Next pi
|
||||
Next i
|
||||
|
||||
'this block loops through items selected in colums, which will be ignored for now
|
||||
'For i = 1 To ci.Count
|
||||
' sql = sql & vbCrLf & "AND "
|
||||
' sql = sql & cd(piv_pos(cd, ci(i).Parent.Position)).Name & " = '" & ci(i).Name & "'"
|
||||
'Next i
|
||||
|
||||
'this loop iterates through every pivot field (even if not in the PT) and determines filtered items
|
||||
'For Each pf In Target.Cells.PivotTable.PivotFields
|
||||
' For Each pi In pf.PivotItems
|
||||
' If Not pi.Visible Then
|
||||
' sql = sql & vbCrLf & "AND " & pf.Name & " <> '" & pi.Name & "'"
|
||||
' End If
|
||||
' Next pi
|
||||
'Next pf
|
||||
|
||||
|
||||
scenario = "{" & handler.jsql & "}"
|
||||
'Sheets("test").Cells(1, 14) = handler.jsql
|
||||
|
||||
Call handler.load_fpvt
|
||||
|
||||
'Call http.pull_months(scenario)
|
||||
|
||||
'jsql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE j @> '{" & jsql & "}'::jsonb"
|
||||
'sql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE " & sql
|
||||
|
||||
'MsgBox (sql)
|
||||
|
||||
'Call wapi.ClipBoard_SetData(sql)
|
||||
|
||||
nopiv:
|
||||
|
||||
End Sub
|
||||
@ -126,3 +91,5 @@ End Function
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user