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

Too many changes, too few commits.

Browse Source 
A lot has changed here, including:
1. Adding pounds to the data available for display in pivot table.
2. Visual improvements
3. Code simplification
4. Hiding / showing sheets as needed. A developer's backdoor allows for
   easy toggling for debugging purposes: Ctrl+RightClick on the Forecast
   Adjustment form's "Selected Scenario" label.
5. Fixed a bug that happened when deleting rows from the basket. The
   definition of the Target variable was lost in some cases.
6. Made use of the Cancel and Default form properties to purge some
   unnecessary code.
7. Added a sheet that contains Help text for the users.
8. Replacing more harcoded range reference with range names.
9. Refactor checks for division by zero errors, and improve error
   messages for users.
10. Remove manual formatting. It's already done and saved in the
    workbook; there's no need to redo it in code.
11. Added more data validation before Save operation proceeds.
12. Added a new IntersectsWith function to simplify If statements.
This commit is contained in:
PhilRunninger 2023-04-24 21:09:12 -04:00
parent 81174b5d57
commit fde6c97964
16 changed files with 720 additions and 1085 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
VBA/Utils.bas
View File

@ -382,15 +382,15 @@ End Function
Public Function ARRAYp_MakeInteger(ParamArray items()) As Integer()
Dim x() As Integer
Dim X() As Integer
Dim i As Integer
ReDim x(UBound(items))
ReDim X(UBound(items))
For i = 0 To UBound(items())
x(i) = items(i)
X(i) = items(i)
Next i
ARRAYp_MakeInteger = x
ARRAYp_MakeInteger = X
End Function
@ -604,15 +604,17 @@ Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox,
'lbHEAD.ZOrder (0)
hdr.SpecialEffect = fmSpecialEffectFlat
'hdr.BackColor = RGB(200, 200, 200)
hdr.Height = 10
'hdr.Height = 15
' align header to body (should be done last!)
hdr.width = det.width
hdr.Left = det.Left
hdr.Top = det.Top - (hdr.Height - 1)
hdr.Top = det.Top - (hdr.Height + 3)
End Sub
Public Function IntersectsWith(Range1 As Range, Range2 As Range) As Boolean
IntersectsWith = Not Application.Intersect(Range1, Range2) Is Nothing
End Function

70
VBA/build.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build
Caption = "UserForm1"
ClientHeight = 3015
Caption = "Change the Mix"
ClientHeight = 1590
ClientLeft = 120
ClientTop = 465
ClientWidth = 8100
ClientWidth = 10725
OleObjectBlob = "build.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -13,61 +13,27 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public part As String
Public bill As String
Public ship As String
Public useval As Boolean
Option Explicit
Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
Public useval As Boolean
Private Sub cmdCancel_Click()
useval = False
Me.Hide
End Sub
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
Private Sub cmdOK_Click()
useval = True
Me.Hide
End Sub
Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
End Sub
Private Sub UserForm_Activate()
Public Sub Initialize(part As String, billTo As String, shipTo As String)
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
cbPart.value = part
cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbBill.value = billTo
cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbShip.value = shipTo
useval = False
cbPart.value = part
cbBill.value = bill
cbShip.value = ship
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.value
End Sub

BIN
VBA/build.frx
View File

Binary file not shown.

75
VBA/changes.frm
View File

@ -1,7 +1,7 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
Caption = "History"
ClientHeight = 7785
ClientHeight = 7815
ClientLeft = 120
ClientTop = 465
ClientWidth = 16710
@ -13,93 +13,54 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private x As Variant
Private X As Variant
Private Sub cbCancel_Click()
Me.Hide
End Sub
Private Sub cbUndo_Click()
Call Me.delete_selected
End Sub
Private Sub lbHist_Change()
Dim i As Integer
For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then
Me.tbPrint.value = x(i, 7)
Me.tbPrint.value = X(i, 7)
Exit Sub
End If
Next i
End Sub
Private Sub lbHist_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 46
Call Me.delete_selected
Case 27
Call Me.Hide
End Select
End Sub
Private Sub UserForm_Activate()
Dim fail As Boolean
'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
x = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", fail)
X = handler.list_changes("{""scenario"":{""quota_rep_descr"":""" & shData.Cells(2, 5) & """}}", fail)
If fail Then
Me.Hide
Exit Sub
End If
Me.lbHist.list = x
Me.lbHist.list = X
lbHEAD.ColumnCount = lbHist.ColumnCount
lbHEAD.ColumnWidths = lbHist.ColumnWidths
'lbHEAD.ColumnCount = lbHist.ColumnCount
'lbHEAD.ColumnWidths = lbHist.ColumnWidths
' add header elements
lbHEAD.clear
lbHEAD.AddItem
lbHEAD.list(0, 0) = "Modifier"
lbHEAD.list(0, 1) = "Owner"
lbHEAD.list(0, 2) = "When"
lbHEAD.list(0, 3) = "Tag"
lbHEAD.list(0, 4) = "Comment"
lbHEAD.list(0, 5) = "Sales"
lbHEAD.list(0, 6) = "id"
' lbHEAD.clear
' lbHEAD.AddItem
' lbHEAD.list(0, 0) = "Modifier"
' lbHEAD.list(0, 1) = "Owner"
' lbHEAD.list(0, 2) = "When"
' lbHEAD.list(0, 3) = "Tag"
' lbHEAD.list(0, 4) = "Comment"
' lbHEAD.list(0, 5) = "Sales"
' lbHEAD.list(0, 6) = "id"
Call Utils.frmListBoxHeader(Me.lbHEAD, Me.lbHist, "Modifier", "Owner", "When", "Tag", "Comment", "Sales", "id")
' make it pretty
'body.ZOrder (1)
'lbHEAD.ZOrder (0)
'lbHEAD.SpecialEffect = fmSpecialEffectFlat
'lbHEAD.BackColor = RGB(200, 200, 200)
'lbHEAD.Height = 10
' align header to body (should be done last!)
'lbHEAD.width = lbHist.width
'lbHEAD.Left = lbHist.Left
'lbHEAD.Top = lbHist.Top - (lbHEAD.Height - 1)
End Sub
Sub delete_selected()
Dim logid As Integer
Dim i As Integer
Dim fail As Boolean
@ -109,10 +70,9 @@ Sub delete_selected()
Exit Sub
End If
For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then
Call handler.undo_changes(x(i, 6), fail)
Call handler.undo_changes(X(i, 6), fail)
If fail Then
MsgBox ("undo did not work")
Exit Sub
@ -124,5 +84,4 @@ Sub delete_selected()
Me.lbHist.clear
Me.Hide
End Sub

BIN
VBA/changes.frx
View File

Binary file not shown.

257
VBA/fpvt.frm
View File

@ -1,7 +1,7 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
Caption = "Forecast Adjustment"
ClientHeight = 8595.001
ClientHeight = 8490.001
ClientLeft = 120
ClientTop = 465
ClientWidth = 8670.001
@ -31,7 +31,6 @@ Private set_swapalt As Boolean
Private return_swap As Boolean
Private jswap As Object
Private cswap As Object
Private cust_s() As Boolean
Private bVol As Double
Private bVal As Double
@ -61,18 +60,19 @@ Private fPrcm As Double
Option Explicit
Private Sub cbCancel_Click()
tbAdjVol.value = 0
tbAdjVal.value = 0
tbAdjPrice.value = 0
fpvt.Hide
'=====================================================================================================
' Developers' backdoor to enter or exit debug mode: Ctrl-RightClick on the "Selected Scenario"
' label at the top of the form. Debug Mode shows the Pending Changes tab in the form, as well
' as all hidden sheets.
Private Sub Label62_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 And Shift = 2 Then
shConfig.Range("debug_mode") = Not shConfig.Range("debug_mode")
mp.Pages("pAPIDOC").Visible = shConfig.Range("debug_mode")
End If
End Sub
'=====================================================================================================
Private Sub butAdjust_Click()
Dim fail As Boolean
Dim doc As String
@ -81,7 +81,7 @@ Private Sub butAdjust_Click()
Exit Sub
End If
If cbTag.text = "" Then
If cbTAG.text = "" Then
MsgBox ("no tag was selected")
Exit Sub
End If
@ -112,22 +112,18 @@ Private Sub butAdjust_Click()
End If
Me.tbCOM = ""
Me.cbTag.text = ""
Me.cbTAG.text = ""
Me.Hide
Set adjust = Nothing
End Sub
Private Sub butCancel_Click()
Me.Hide
End Sub
Private Sub butMAdjust_Click()
Dim i As Integer
Dim fail As Boolean
@ -138,43 +134,31 @@ Private Sub butMAdjust_Click()
Next i
Me.Hide
End Sub
Private Sub butMCancel_Click()
Me.Hide
End Sub
Private Sub cbGoSheet_Click()
shMonthView.Range("MonthComment").value = ""
shMonthView.Cells(19, 5).value = 0
shMonthView.Cells(19, 11).value = 0
Me.Hide
shMonthView.Range("MonthTags").value = ""
shMonthView.Range("MonthTag").value = ""
shMonthView.Range("QtyPctChange").value = 0
shMonthView.Range("PricePctChange").value = 0
shMonthView.Visible = xlSheetVisible
shMonthView.Select
Me.Hide
End Sub
Private Sub cbTAG_Change()
Dim j As Object
If tbAPI.text = "" Then tbAPI.text = "{}"
Set j = JsonConverter.ParseJson(tbAPI.text)
j("tag") = cbTag.value
j("tag") = cbTAG.value
tbAPI.text = JsonConverter.ConvertToJson(j)
End Sub
Private Sub lbMonth_Change()
If clear_lb Or load_tb Then Exit Sub
Dim i As Long
@ -203,13 +187,9 @@ Private Sub lbMonth_Change()
Exit For
End If
Next i
End Sub
Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
If set_swapalt Then Exit Sub
@ -242,15 +222,13 @@ Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
jswap("user") = Application.UserName
jswap("source") = "adj"
jswap("message") = tbCOM.text
jswap("tag") = cbTag.text
jswap("tag") = cbTAG.text
jswap("type") = "swap"
tbAPI.text = JsonConverter.ConvertToJson(jswap)
End Sub
Private Sub dbGETSWAP_Click()
Dim doc As String
Dim j As Object
Dim fail As Boolean
@ -282,17 +260,13 @@ Private Sub dbGETSWAP_Click()
jswap("user") = Application.UserName
jswap("source") = "adj"
jswap("message") = tbCOM.text
jswap("tag") = cbTag.text
jswap("tag") = cbTAG.text
jswap("type") = "swap"
tbAPI.text = JsonConverter.ConvertToJson(jswap)
End Sub
Private Sub lbSWAP_Change()
Dim i As Long
If return_swap Then Exit Sub
@ -304,40 +278,9 @@ Private Sub lbSWAP_Change()
swapline = i
End If
Next i
End Sub
Private Sub lbSWAP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Dim rx As Object
' Set rx = CreateObject("vbscript.regexp")
' rx.Global = True
' rx.Pattern = " - .*"
' Dim match As Object
' Dim i As Long
' Dim v As Variant
'
' 'v = Me.lbSWAP.list
'
' For i = 0 To Me.lbSWAP.ListCount - 1
' If Me.lbSWAP.Selected(i) Then
' part.Show
' If Not part.useval Then
' Exit Sub
' End If
' 'vSwap(i, 3) = rx.Execute(part.cbPart.value)
' 'v(i, 2) = rx.Replace(part.cbPart.value, "")
' 'Me.lbSWAP.list = v
' End If
' Next i
'
End Sub
Private Sub opEditPrice_Click()
opPlugVol.Enabled = False
opPlugPrice.Enabled = False
opPlugVol.Visible = False
opPlugPrice.Visible = False
opPlugPrice.value = True
@ -356,13 +299,9 @@ Private Sub opEditPrice_Click()
tbpv.Enabled = True
tbpp.Enabled = True
tbpd.Enabled = False
End Sub
Private Sub opEditSales_Click()
opPlugVol.Enabled = True
opPlugPrice.Enabled = True
opPlugVol.Visible = True
opPlugPrice.Visible = True
@ -379,12 +318,9 @@ Private Sub opEditSales_Click()
tbpv.Enabled = False
tbpp.Enabled = False
tbpd.Enabled = True
End Sub
Private Sub opEditPriceM_Click()
opmvol.Enabled = False
opmprice.Enabled = False
opmvol.Visible = False
@ -398,11 +334,9 @@ Private Sub opEditPriceM_Click()
tbMFVal.BackColor = &H80000005
tbMFVol.Enabled = True
tbMFVol.BackColor = &H80000018
End Sub
Private Sub opEditSalesM_Click()
opmvol.Enabled = True
opmprice.Enabled = True
opmvol.Visible = True
@ -414,82 +348,33 @@ Private Sub opEditSalesM_Click()
tbMFVal.BackColor = &H80000018
tbMFVol.Enabled = False
tbMFVol.BackColor = &H80000005
End Sub
Private Sub opEditVolM_Click()
opmvol.Enabled = False
opmprice.Enabled = False
opmprice.value = False
opmvol.value = True
opmvol.Enabled = False
opmprice.Enabled = False
opmvol.Visible = False
opmprice.Visible = False
tbMFPrice.Enabled = False
tbMFPrice.BackColor = &H80000005
tbMFVal.Enabled = False
tbMFVal.BackColor = &H80000005
tbMFVol.Enabled = True
tbMFVol.BackColor = &H80000018
End Sub
Private Sub opPlugPrice_Click()
calc_val
If opPlugPrice.value = True Then
opPlugPrice.BackColor = -2147483624
Else
opPlugPrice.BackColor = -2147483644
End If
If opPlugVol.value = True Then
opPlugVol.BackColor = -2147483624
Else
opPlugVol.BackColor = -2147483644
End If
End Sub
Private Sub opPlugVol_Click()
calc_val
If opPlugVol.value = True Then
opPlugVol.BackColor = -2147483624
Else
opPlugVol.BackColor = -2147483644
End If
If opPlugPrice.value = True Then
opPlugPrice.BackColor = -2147483624
Else
opPlugPrice.BackColor = -2147483644
End If
End Sub
Private Sub sbpd_Change()
tbpd.value = sbpd.value
End Sub
Private Sub sbpp_Change()
tbpp.value = sbpp.value
End Sub
Private Sub sbpv_Change()
tbpv.value = sbpv.value
End Sub
Private Sub tbCOM_Change()
If tbAPI.text = "" Then tbAPI.text = "{}"
Set adjust = JsonConverter.ParseJson(tbAPI.text)
adjust("message") = tbCOM.text
tbAPI.text = JsonConverter.ConvertToJson(adjust)
End Sub
Private Sub tbFcPrice_Change()
@ -500,10 +385,8 @@ Private Sub tbFcPrice_Change()
End Sub
Private Sub tbFcVal_Change()
If load_tb Then Exit Sub
If opEditSales Then calc_val
End Sub
Private Sub tbFcVol_Change()
@ -522,72 +405,55 @@ Private Sub opmVol_Click()
End Sub
Private Sub tbmfPrice_Change()
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
set_Price = True
If opEditPriceM Then calc_mprice
set_Price = False
End Sub
Private Sub tbMFVal_Change()
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
If opEditSalesM Then calc_mval
End Sub
Private Sub tbmfVol_Change()
If mline = 0 Then Exit Sub
If clear_lb Or load_tb Then Exit Sub
If opEditPriceM Then calc_mprice
End Sub
Private Sub tbpd_Change()
If load_tb Then Exit Sub
If Not VBA.IsNumeric(tbpd.value) Then
tbpd = "0"
End If
tbFcVal = (bVal + pVal) * (1 + tbpd.value / 100)
End Sub
Private Sub tbpp_Change()
If load_tb Then Exit Sub
If Not VBA.IsNumeric(tbpd.value) Then
tbpd = "0"
End If
tbFcPrice = (bPrc + pPrc) * (1 + tbpp.value / 100)
Me.load_mbox_ann
End Sub
Private Sub tbpv_Change()
If load_tb Then Exit Sub
If Not VBA.IsNumeric(tbpv.value) Then
tbpd = "0"
End If
tbFcVol = (bVol + pVol) * (1 + tbpv.value / 100)
End Sub
Private Sub UserForm_Activate()
Dim i As Long
Dim j As Long
Dim k As Long
Dim ok As Boolean
' Dim tags() As Variant
Me.Caption = "Forecast Adjust " & shConfig.Range("version").value & " Loading..."
Me.mp.Visible = False
@ -604,7 +470,6 @@ Private Sub UserForm_Activate()
Exit Sub
End If
'---show existing adjustment if there is one----
fpvt.mod_adjust = False
pVol = 0
@ -719,7 +584,6 @@ Private Sub UserForm_Activate()
basket(0, 2) = "ship_cust_descr"
basket(0, 3) = "mix"
For i = 1 To UBound(basket, 1)
'basket(i, 0) = sp("package")("base")(i)("order_season")
'basket(i, 1) = sp("package")("base")(i)("order_month")
@ -740,7 +604,6 @@ Private Sub UserForm_Activate()
ReDim cust(sp("package")("customers").Count - 1, 3)
For i = 0 To UBound(cust, 1)
cust(i, 0) = sp("package")("customers")(i + 1)("bill_cust_descr")
cust(i, 1) = ""
@ -750,9 +613,8 @@ Private Sub UserForm_Activate()
Call Utils.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
'-------------load tags-------------------------------
cbTag.list = shConfig.ListObjects("TAGS").DataBodyRange.value
cbTAG.list = shConfig.ListObjects("TAGS").DataBodyRange.value
'----------reset spinner buttons----------------------
sbpv.value = 0
@ -769,25 +631,11 @@ Private Sub UserForm_Activate()
lbCUST.list = cust
Call Utils.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
'---------price volume radio button colors----------
If opPlugPrice.value = True Then
opPlugPrice.BackColor = -2147483624
Else
opPlugPrice.BackColor = -2147483644
End If
If opPlugVol.value = True Then
opPlugVol.BackColor = -2147483624
Else
opPlugVol.BackColor = -2147483644
End If
'Application.Calculation = xlCalculationManual
Call handler.month_tosheet(month, basket)
Application.StatusBar = False
Me.mp.Visible = True
Me.fraExit.Visible = True
End Sub
Sub crunch_array()
@ -828,56 +676,46 @@ Sub crunch_array()
lbMonth.clear
lbMonth.list = mload
clear_lb = False
End Sub
Private Sub lbCUST_Change()
Dim i As Long
Dim x() As Variant
Dim X() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
X = lbCUST.list
For i = 0 To UBound(X, 1)
If lbCUST.Selected(i) Then Exit For
Next i
cbBT.text = x(i, 0)
cbST.text = x(i, 2)
cbBT.text = X(i, 0)
cbST.text = X(i, 2)
End Sub
Private Sub cbBT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
Dim x() As Variant
Dim X() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then x(i, 1) = Me.rev_cust(cbBT.text)
X = lbCUST.list
For i = 0 To UBound(X, 1)
If lbCUST.Selected(i) Then X(i, 1) = Me.rev_cust(cbBT.text)
Next i
lbCUST.list = x
lbCUST.list = X
Call Me.build_cust_swap
End Sub
Private Sub cbST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
Dim x() As Variant
Dim X() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then x(i, 3) = Me.rev_cust(cbST.text)
X = lbCUST.list
For i = 0 To UBound(X, 1)
If lbCUST.Selected(i) Then X(i, 3) = Me.rev_cust(cbST.text)
Next i
lbCUST.list = x
lbCUST.list = X
Call Me.build_cust_swap
End Sub
Sub build_cust_swap()
@ -896,17 +734,14 @@ Sub build_cust_swap()
cswap("user") = Application.UserName
cswap("source") = "adj"
cswap("message") = tbCOM.text
cswap("tag") = cbTag.text
cswap("tag") = cbTAG.text
cswap("type") = "cust_swap"
Set cswap("swap") = JsonConverter.ParseJson(ptable)
tbAPI.text = JsonConverter.ConvertToJson(cswap)
End Sub
Public Function rev_cust(cust As String) As String
If cust = "" Then
rev_cust = ""
Exit Function
@ -938,7 +773,6 @@ Sub load_var()
aVolm = fVolm - (bVolm + pVolm)
aValm = fValm - (bValm + pValm)
If month(mline, 9) = "addmonth" Then
nomonth = True
bPrcm = month(13, 6) / month(13, 2)
@ -951,7 +785,6 @@ Sub load_var()
If fVolm <> 0 Then fPrcm = fValm / fVolm
aPrcm = fPrcm - (bPrcm + pPrcm)
End If
End Sub
Sub load_mbox()
@ -975,7 +808,6 @@ Sub load_mbox()
tbMAPrice = Format(aPrcm, "0.00000")
load_tb = False
End Sub
Sub load_mbox_ann()
@ -999,7 +831,6 @@ Sub load_mbox_ann()
tbAdjPrice = Format(aPrc, "0.00000")
load_tb = False
End Sub
Sub load_array()
@ -1017,10 +848,8 @@ Sub load_array()
month(mline, 8) = fValm
Me.crunch_array
End Sub
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
If Not IsNumeric(one) Or IsNull(one) Then
@ -1082,7 +911,7 @@ Sub calc_val()
adjust("user") = Application.UserName
adjust("source") = "adj"
adjust("message") = tbCOM.text
adjust("tag") = cbTag.text
adjust("tag") = cbTAG.text
If opEditSales Then
If opPlugVol Then
adjust("type") = "scale_v"
@ -1100,7 +929,6 @@ Sub calc_val()
'print json
tbAPI = JsonConverter.ConvertToJson(adjust)
End Sub
Sub calc_price()
@ -1136,7 +964,7 @@ Sub calc_price()
adjust("user") = Application.UserName
adjust("source") = "adj"
adjust("message") = tbCOM.text
adjust("tag") = cbTag.text
adjust("tag") = cbTAG.text
adjust("version") = handler.plan
If opEditSales Then
@ -1159,10 +987,8 @@ Sub calc_price()
'print json
tbAPI = JsonConverter.ConvertToJson(adjust)
End Sub
Sub calc_mval()
Dim pchange As Double
@ -1244,7 +1070,6 @@ Sub calc_mval()
Me.load_mbox
Me.load_array
End Sub
Sub calc_mprice()
@ -1316,11 +1141,9 @@ Sub calc_mprice()
month(mline, 10) = JsonConverter.ConvertToJson(j)
tbAPI = JsonConverter.ConvertToJson(j)
If clear_lb Then MsgBox ("clear")
Me.load_mbox
Me.load_array
End Sub
Function iter_def(ByVal iter As String) As String
@ -1344,3 +1167,5 @@ Function iter_def(ByVal iter As String) As String
iter_def = "exclude"
End Function

BIN
VBA/fpvt.frx
View File

Binary file not shown.

6
VBA/handler.bas
View File

@ -104,7 +104,7 @@ Sub pg_main_workset(rep As String)
Exit Sub
End If
ReDim res(json("x").Count, 33)
ReDim res(json("x").Count, 34)
For i = 1 To UBound(res, 1)
res(i, 0) = json("x")(i)("bill_cust_descr")
@ -141,6 +141,7 @@ Sub pg_main_workset(rep As String)
res(i, 31) = json("x")(i)("logid")
res(i, 32) = json("x")(i)("tag")
res(i, 33) = json("x")(i)("comment")
res(i, 34) = json("x")(i)("pounds")
Next i
res(0, 0) = "bill_cust_descr"
@ -177,6 +178,7 @@ Sub pg_main_workset(rep As String)
res(0, 31) = "logid"
res(0, 32) = "tag"
res(0, 33) = "comment"
res(0, 34) = "pounds"
Set json = Nothing
@ -456,7 +458,7 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
shConfig.Range("show_basket").value = 0
shConfig.Range("new_part").value = 0
shMonthView.load_sheet
shMonthView.LoadSheet
End With

7
VBA/openf.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
Caption = "Open a Forecast"
ClientHeight = 2025
ClientHeight = 1365
ClientLeft = 120
ClientTop = 465
ClientWidth = 3825
ClientWidth = 6825
OleObjectBlob = "openf.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -33,10 +33,7 @@ End Sub
Private Sub UserForm_Activate()
'handler.server = "http://192.168.1.69:3000"
handler.server = shConfig.Range("server").value
openf.Caption = "Select a DSM"
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value
End Sub

BIN
VBA/openf.frx
View File

Binary file not shown.

31
VBA/part.frm
View File

@ -1,10 +1,10 @@
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part
Caption = "Part Picker"
ClientHeight = 1080
ClientHeight = 1335
ClientLeft = 120
ClientTop = 465
ClientWidth = 8100
ClientWidth = 9285.001
OleObjectBlob = "part.frx":0000
StartUpPosition = 1 'CenterOwner
End
@ -13,34 +13,23 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public part As String
Public bill As String
Public ship As String
Public useval As Boolean
Option Explicit
Public useval As Boolean
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
useval = True
Me.Hide
Case 27
useval = False
Me.Hide
End Select
Private Sub cmdCancel_Click()
useval = False
Me.Hide
End Sub
Private Sub cmdOK_Click()
useval = True
Me.Hide
End Sub
Private Sub UserForm_Activate()
useval = False
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.value
End Sub

BIN
VBA/part.frx
View File

Binary file not shown.

20
VBA/shConfig.cls
View File

@ -7,3 +7,23 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If shConfig.Range("debug_mode").value Then
shConfig.Visible = xlSheetVisible
shData.Visible = xlSheetVisible
shMonthView.Visible = xlSheetVisible
shMonthUpdate.Visible = xlSheetVisible
shSupportingData.Visible = xlSheetVisible
shWalk.Visible = xlSheetVisible
Else
shConfig.Visible = xlSheetVeryHidden
shData.Visible = xlSheetHidden
shMonthView.Visible = xlSheetHidden
shMonthUpdate.Visible = xlSheetVeryHidden
shSupportingData.Visible = xlSheetVeryHidden
shWalk.Visible = xlSheetVeryHidden
End If
End Sub

11
VBA/shHelp.cls Normal file
View File

@ -0,0 +1,11 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shHelp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit

755
VBA/shMonthView.cls
View File

File diff suppressed because it is too large Load Diff

1
route_sql/get_pool.sql
View File

@ -36,6 +36,7 @@ SELECT
,sum(cost_loc) cost_loc
,sum(cost_usd) cost_usd
,sum(units) units
,sum(pounds) pounds
,version
,iter
,logid