UI and UX Changes
1. Remove/Hide Swap Part 2. Remove/Hide Swap Customer 3. Improved the location of controls on fpvt form. 4. Make user experience more intuitive on the Month sheet 5. Make more and better use of named ranges in place of hardcoded cell locations. 6. Added error checking to ensure Tag is entered and at least one month has a forecast on Month sheet.
This commit is contained in:
PhilRunninger
parent
12c17b0be6
commit
81174b5d57
BIN
VBA/build.frx
BIN
VBA/build.frx
Binary file not shown.
BIN
VBA/changes.frx
BIN
VBA/changes.frx
Binary file not shown.
50
VBA/fpvt.frm
50
VBA/fpvt.frm
|
|
@ -1,10 +1,10 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
|
||||
Caption = "Forecast Adjustment"
|
||||
ClientHeight = 8445.001
|
||||
ClientHeight = 8595.001
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 8805.001
|
||||
ClientWidth = 8670.001
|
||||
OleObjectBlob = "fpvt.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
|
|
@ -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,7 +112,7 @@ Private Sub butAdjust_Click()
|
|||
End If
|
||||
|
||||
Me.tbCOM = ""
|
||||
Me.cbTAG.text = ""
|
||||
Me.cbTag.text = ""
|
||||
|
||||
Me.Hide
|
||||
|
||||
|
|
@ -150,12 +150,12 @@ End Sub
|
|||
|
||||
Private Sub cbGoSheet_Click()
|
||||
|
||||
shMonthView.tbMCOM.text = ""
|
||||
shMonthView.sbMPV.value = 0
|
||||
shMonthView.sbMPP.value = 0
|
||||
shMonthView.Range("MonthComment").value = ""
|
||||
shMonthView.Cells(19, 5).value = 0
|
||||
shMonthView.Cells(19, 11).value = 0
|
||||
|
||||
Me.Hide
|
||||
shMonthView.cbMTAG.value = ""
|
||||
shMonthView.Range("MonthTags").value = ""
|
||||
shMonthView.Visible = xlSheetVisible
|
||||
shMonthView.Select
|
||||
|
||||
|
|
@ -167,7 +167,7 @@ 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
|
||||
|
|
@ -242,7 +242,7 @@ 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)
|
||||
|
|
@ -282,7 +282,7 @@ 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)
|
||||
|
|
@ -587,17 +587,16 @@ Private Sub UserForm_Activate()
|
|||
Dim j As Long
|
||||
Dim k As Long
|
||||
Dim ok As Boolean
|
||||
Dim tags() As Variant
|
||||
' Dim tags() As Variant
|
||||
|
||||
Me.Caption = "Forecast Adjust " & shConfig.Cells(8, 2)
|
||||
Me.Caption = "Forecast Adjust " & shConfig.Range("version").value & " Loading..."
|
||||
Me.mp.Visible = False
|
||||
Me.fraExit.Visible = False
|
||||
|
||||
Me.lheader = "Loading..."
|
||||
|
||||
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
||||
Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
|
||||
|
||||
Me.lheader = "Ready"
|
||||
Me.Caption = "Forecast Adjust " & shConfig.Range("version").value
|
||||
|
||||
If Not ok Then
|
||||
fpvt.Hide
|
||||
|
|
@ -753,16 +752,7 @@ Private Sub UserForm_Activate()
|
|||
|
||||
|
||||
'-------------load tags-------------------------------
|
||||
If Not IsNull(sp("package")("tags")) Then
|
||||
ReDim tags(sp("package")("tags").Count - 1, 0)
|
||||
For i = 1 To sp("package")("tags").Count
|
||||
tags(i - 1, 0) = sp("package")("tags")(i)
|
||||
Next i
|
||||
cbTAG.list = tags
|
||||
shMonthView.cbMTAG.list = tags
|
||||
cbTAG.ListRows = UBound(tags, 1) + 1
|
||||
shMonthView.cbMTAG.ListRows = UBound(tags, 1) + 1
|
||||
End If
|
||||
cbTag.list = shConfig.ListObjects("TAGS").DataBodyRange.value
|
||||
|
||||
'----------reset spinner buttons----------------------
|
||||
sbpv.value = 0
|
||||
|
|
@ -796,7 +786,7 @@ Private Sub UserForm_Activate()
|
|||
Application.StatusBar = False
|
||||
|
||||
Me.mp.Visible = True
|
||||
|
||||
Me.fraExit.Visible = True
|
||||
|
||||
End Sub
|
||||
|
||||
|
|
@ -906,7 +896,7 @@ 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)
|
||||
|
||||
|
|
@ -1092,7 +1082,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"
|
||||
|
|
@ -1146,7 +1136,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
|
||||
|
|
|
|||
BIN
VBA/fpvt.frx
BIN
VBA/fpvt.frx
Binary file not shown.
|
|
@ -98,6 +98,12 @@ Sub pg_main_workset(rep As String)
|
|||
Exit Sub
|
||||
End If
|
||||
Set json = JsonConverter.ParseJson(wr)
|
||||
|
||||
If IsNull(json("x")) Then
|
||||
MsgBox "No data found for " & rep & "."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
ReDim res(json("x").Count, 33)
|
||||
|
||||
For i = 1 To UBound(res, 1)
|
||||
|
|
@ -209,7 +215,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
|||
'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
|
||||
'doc = JsonConverter.ConvertToJson(doc)
|
||||
|
||||
server = shConfig.Cells(1, 2)
|
||||
server = shConfig.Range("server").value
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
|
|
@ -322,41 +328,31 @@ End Function
|
|||
Sub load_config()
|
||||
|
||||
Dim i As Integer
|
||||
Dim j As Integer
|
||||
'----server to use---------------------------------------------------------
|
||||
handler.server = shConfig.Cells(1, 2)
|
||||
handler.server = shConfig.Range("server").value
|
||||
'---basis-----------------------------------------------------------------
|
||||
ReDim handler.basis(100)
|
||||
i = 2
|
||||
j = 0
|
||||
Do While shConfig.Cells(2, i) <> ""
|
||||
handler.basis(j) = shConfig.Cells(2, i)
|
||||
j = j + 1
|
||||
i = i + 1
|
||||
Loop
|
||||
ReDim Preserve handler.basis(j - 1)
|
||||
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-----------------------------------------------------------------
|
||||
ReDim handler.baseline(100)
|
||||
i = 2
|
||||
j = 0
|
||||
Do While shConfig.Cells(3, i) <> ""
|
||||
handler.baseline(j) = shConfig.Cells(3, i)
|
||||
j = j + 1
|
||||
i = i + 1
|
||||
Loop
|
||||
ReDim Preserve handler.baseline(j - 1)
|
||||
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-----------------------------------------------------------------
|
||||
ReDim handler.adjust(100)
|
||||
i = 2
|
||||
j = 0
|
||||
Do While shConfig.Cells(4, i) <> ""
|
||||
handler.adjust(j) = shConfig.Cells(4, i)
|
||||
j = j + 1
|
||||
i = i + 1
|
||||
Loop
|
||||
ReDim Preserve handler.adjust(j - 1)
|
||||
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.Cells(9, 2)
|
||||
handler.plan = shConfig.Range("budget").value
|
||||
|
||||
End Sub
|
||||
|
||||
|
|
@ -456,9 +452,9 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
|||
.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.Cells(5, 2) = 0
|
||||
shConfig.Cells(6, 2) = 0
|
||||
shConfig.Cells(7, 2) = 0
|
||||
shConfig.Range("rebuild").value = 0
|
||||
shConfig.Range("show_basket").value = 0
|
||||
shConfig.Range("new_part").value = 0
|
||||
|
||||
shMonthView.load_sheet
|
||||
|
||||
|
|
@ -491,7 +487,7 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
|
|||
Exit Function
|
||||
End If
|
||||
|
||||
server = shConfig.Cells(1, 2)
|
||||
server = shConfig.Range("server").value
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
|
|
@ -604,7 +600,7 @@ Function get_swap_fit(doc As String, ByRef fail As Boolean) As Variant()
|
|||
Exit Function
|
||||
End If
|
||||
|
||||
server = shConfig.Cells(1, 2)
|
||||
server = shConfig.Range("server").value
|
||||
|
||||
With req
|
||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ End Sub
|
|||
Private Sub UserForm_Activate()
|
||||
|
||||
'handler.server = "http://192.168.1.69:3000"
|
||||
handler.server = shConfig.Cells(1, 2)
|
||||
handler.server = shConfig.Range("server").value
|
||||
|
||||
openf.Caption = "Select a DSM"
|
||||
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.value
|
||||
|
|
|
|||
BIN
VBA/openf.frx
BIN
VBA/openf.frx
Binary file not shown.
BIN
VBA/part.frx
BIN
VBA/part.frx
Binary file not shown.
|
|
@ -19,7 +19,6 @@ Private dumping As Boolean
|
|||
Private vedit As String
|
||||
Private adjust() As Object
|
||||
Private jtext() As Variant
|
||||
Private basejson As Object
|
||||
Private rollback As Boolean
|
||||
Private scenario() As Variant
|
||||
Private orig As Range
|
||||
|
|
@ -29,21 +28,38 @@ Private np As Object 'json dedicated to new part scenario
|
|||
Private b() As Variant 'holds basket
|
||||
Private did_load_config As Boolean
|
||||
|
||||
Public Sub MPP_Down() ' Handler for down-triangle on price percent change.
|
||||
If newpart Then Exit Sub
|
||||
|
||||
With shMonthView.Range("PricePctChange")
|
||||
.value = WorksheetFunction.Max(-0.1, .value - 0.01)
|
||||
End With
|
||||
MPP_Change
|
||||
End Sub
|
||||
|
||||
Private Sub sbMPP_Change()
|
||||
Dim m As Worksheet
|
||||
Public Sub MPP_Up() ' Handler for up-triangle on price percent change.
|
||||
If newpart Then Exit Sub
|
||||
|
||||
With shMonthView.Range("PricePctChange")
|
||||
.value = WorksheetFunction.Min(0.1, .value + 0.01)
|
||||
End With
|
||||
MPP_Change
|
||||
End Sub
|
||||
|
||||
Private Sub MPP_Change()
|
||||
Dim i As Long
|
||||
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
dumping = True
|
||||
|
||||
Set m = shMonthView
|
||||
m.Cells(19, 11) = sbMPP.value / 100
|
||||
For i = 6 To 17
|
||||
m.Cells(i, 11) = (m.Cells(i, 9)) * m.Cells(19, 11)
|
||||
Next i
|
||||
|
||||
With shMonthView
|
||||
For i = 1 To 12
|
||||
If .Range("PriceBaseline").Cells(i) > 0 Then
|
||||
.Range("PriceNewAdj").Cells(i) = .Range("PriceBaseline").Cells(i) * .Range("PricePctChange")
|
||||
End If
|
||||
Next i
|
||||
End With
|
||||
Me.mvp_adj
|
||||
|
||||
dumping = False
|
||||
|
|
@ -52,87 +68,91 @@ Private Sub sbMPP_Change()
|
|||
End Sub
|
||||
|
||||
|
||||
Private Sub sbMPV_Change()
|
||||
Dim m As Worksheet
|
||||
Public Sub MPV_Down() ' Handler for down-triangle on qty percent change.
|
||||
If newpart Then Exit Sub
|
||||
|
||||
With shMonthView.Range("QtyPctChange")
|
||||
.value = WorksheetFunction.Max(-0.1, .value - 0.01)
|
||||
End With
|
||||
MPV_Change
|
||||
End Sub
|
||||
|
||||
Public Sub MPV_Up() ' Handler for up-triangle on qty percent change.
|
||||
If newpart Then Exit Sub
|
||||
|
||||
With shMonthView.Range("QtyPctChange")
|
||||
.value = WorksheetFunction.Min(0.1, .value + 0.01)
|
||||
End With
|
||||
MPV_Change
|
||||
End Sub
|
||||
|
||||
Private Sub MPV_Change()
|
||||
Dim i As Long
|
||||
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
dumping = True
|
||||
|
||||
Set m = shMonthView
|
||||
m.Cells(19, 5) = sbMPV.value / 100
|
||||
For i = 6 To 17
|
||||
If m.Cells(i, 5) <> "" Then
|
||||
m.Cells(i, 5) = (m.Cells(i, 3)) * m.Cells(19, 5)
|
||||
End If
|
||||
Next i
|
||||
With shMonthView
|
||||
For i = 1 To 12
|
||||
If .Range("QtyBaseline").Cells(i) <> 0 Then
|
||||
.Range("QtyNewAdj").Cells(i) = .Range("QtyBaseline").Cells(i) * .Range("QtyPctChange")
|
||||
End If
|
||||
Next i
|
||||
End With
|
||||
|
||||
dumping = False
|
||||
|
||||
Call Me.mvp_adj
|
||||
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub tbMCOM_Change()
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
|
||||
'---this needs checked prior to dumping check becuase % increase spinners are flagged as dumps
|
||||
'---this needs checked prior to dumping check because % increase spinners are flagged as dumps
|
||||
If Not did_load_config Then
|
||||
Call handler.load_config
|
||||
did_load_config = True
|
||||
End If
|
||||
|
||||
If Not dumping Then
|
||||
If dumping Then Exit Sub
|
||||
|
||||
If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
|
||||
If Target.Columns.Count > 1 Then
|
||||
MsgBox ("you can only change one column at a time - your change will be undone")
|
||||
dumping = True
|
||||
Application.Undo
|
||||
dumping = False
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not Intersect(Target, Range("A1:R18")) Is Nothing Then
|
||||
If Target.Columns.Count > 1 Then
|
||||
MsgBox ("you can only change one column at a time - your change will be undone")
|
||||
dumping = True
|
||||
Application.Undo
|
||||
dumping = False
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not Intersect(Target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(Target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(Target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(Target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj
|
||||
If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set
|
||||
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
|
||||
Set basket_touch = Target
|
||||
Call Me.get_edit_basket
|
||||
Set basket_touch = Nothing
|
||||
End If
|
||||
|
||||
If Not Intersect(Target, Range("QtyNewAdj")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(Target, Range("QtyFinal")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(Target, Range("PriceNewAdj")) Is Nothing Then Call Me.mvp_adj
|
||||
If Not Intersect(Target, Range("PriceFinal")) Is Nothing Then Call Me.mvp_set
|
||||
If Not Intersect(Target, Range("SalesNewAdj")) Is Nothing Then Call Me.ms_adj
|
||||
If Not Intersect(Target, Range("SalesFinal")) Is Nothing Then Call Me.ms_set
|
||||
|
||||
If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
||||
Set basket_touch = Target
|
||||
Call Me.get_edit_basket
|
||||
Set basket_touch = Nothing
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||
|
||||
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
|
||||
If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
||||
Cancel = True
|
||||
Call Me.basket_pick(Target)
|
||||
Target.Select
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub picker_shortcut()
|
||||
|
||||
If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
|
||||
If Not Intersect(Selection, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
||||
Call Me.basket_pick(Selection)
|
||||
End If
|
||||
|
||||
|
|
@ -140,7 +160,7 @@ End Sub
|
|||
|
||||
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
|
||||
|
||||
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And shConfig.Cells(6, 2) = 1 Then
|
||||
If Not Intersect(Target, Range("basket")) Is Nothing And shConfig.Range("show_basket").value = 1 Then
|
||||
Cancel = True
|
||||
Call Me.basket_pick(Target)
|
||||
Target.Select
|
||||
|
|
@ -220,7 +240,7 @@ On Error GoTo errh
|
|||
Dim i As Integer
|
||||
Call Me.get_sheet
|
||||
Dim vp As String
|
||||
vp = shMonthView.Range("Q2")
|
||||
vp = shMonthView.Range("MonthVariable")
|
||||
|
||||
For i = 1 To 12
|
||||
If sales(i, 5) = "" Then sales(i, 5) = 0
|
||||
|
|
@ -276,7 +296,7 @@ Sub ms_adj()
|
|||
Dim i As Integer
|
||||
Call Me.get_sheet
|
||||
Dim vp As String
|
||||
vp = shMonthView.Range("Q2")
|
||||
vp = shMonthView.Range("MonthVariable")
|
||||
|
||||
For i = 1 To 12
|
||||
If sales(i, 4) = "" Then sales(i, 4) = 0
|
||||
|
|
@ -329,30 +349,33 @@ Sub get_sheet()
|
|||
|
||||
Dim i As Integer
|
||||
|
||||
units = Range("B6:F17")
|
||||
price = Range("H6:L17")
|
||||
sales = Range("N6:R17")
|
||||
tunits = Range("B18:F18")
|
||||
tprice = Range("H18:L18")
|
||||
tsales = Range("N18:R18")
|
||||
units = Range("units")
|
||||
price = Range("price")
|
||||
sales = Range("sales")
|
||||
tunits = Range("tunits")
|
||||
tprice = Range("tprice")
|
||||
tsales = Range("tsales")
|
||||
ReDim adjust(12)
|
||||
Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Function basejson() As Object
|
||||
Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
|
||||
End Function
|
||||
|
||||
Sub set_sheet()
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
dumping = True
|
||||
|
||||
Range("B6:F17") = units
|
||||
Range("H6:L17") = price
|
||||
Range("N6:R17") = sales
|
||||
Range("B18:F18").FormulaR1C1 = tunits
|
||||
Range("H18:L18").FormulaR1C1 = tprice
|
||||
Range("N18:R18").FormulaR1C1 = tsales
|
||||
Range("T6:U18").ClearContents
|
||||
Range("units") = units
|
||||
Range("price") = price
|
||||
Range("sales") = sales
|
||||
Range("tunits").FormulaR1C1 = tunits
|
||||
Range("tprice").FormulaR1C1 = tprice
|
||||
Range("tsales").FormulaR1C1 = tsales
|
||||
Range("scenario").ClearContents
|
||||
Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("R1")), shMonthView.Name, 6, 20, False, False, False)
|
||||
'shMonthView.Range("B32:Q5000").ClearContents
|
||||
|
||||
|
|
@ -375,9 +398,9 @@ Sub load_sheet()
|
|||
price = shMonthUpdate.Range("F2:J13").FormulaR1C1
|
||||
sales = shMonthUpdate.Range("K2:O13").FormulaR1C1
|
||||
scenario = shMonthUpdate.Range("R1:S13").FormulaR1C1
|
||||
tunits = Range("B18:F18")
|
||||
tprice = Range("H18:L18")
|
||||
tsales = Range("N18:R18")
|
||||
tunits = Range("tunits")
|
||||
tprice = Range("tprice")
|
||||
tsales = Range("tsales")
|
||||
'reset basket
|
||||
shMonthUpdate.Range("U1:X10000").ClearContents
|
||||
Call Utils.SHTp_DumpVar(Utils.SHTp_get_block(shMonthUpdate.Range("Z1")), shMonthUpdate.Name, 1, 21, False, False, False)
|
||||
|
|
@ -402,17 +425,17 @@ Sub set_format()
|
|||
Dim val_adj As Range
|
||||
Dim val_set As Range
|
||||
|
||||
Set prices = shMonthView.Range("H6:L17")
|
||||
Set price_adj = shMonthView.Range("K6:K17")
|
||||
Set price_set = shMonthView.Range("L6:L17")
|
||||
Set prices = shMonthView.Range("price")
|
||||
Set price_adj = shMonthView.Range("PriceNewAdj")
|
||||
Set price_set = shMonthView.Range("PriceFinal")
|
||||
|
||||
Set vol = shMonthView.Range("B6:F17")
|
||||
Set vol_adj = shMonthView.Range("E6:E17")
|
||||
Set vol_set = shMonthView.Range("F6:F17")
|
||||
Set vol = shMonthView.Range("units")
|
||||
Set vol_adj = shMonthView.Range("QtyNewAdj")
|
||||
Set vol_set = shMonthView.Range("QtyFinal")
|
||||
|
||||
Set val = shMonthView.Range("N6:R17")
|
||||
Set val_adj = shMonthView.Range("Q6:Q17")
|
||||
Set val_set = shMonthView.Range("R6:R17")
|
||||
Set val = shMonthView.Range("sales")
|
||||
Set val_adj = shMonthView.Range("SalesNewAdj")
|
||||
Set val_set = shMonthView.Range("SalesFinal")
|
||||
|
||||
Call Me.format_price(prices)
|
||||
Call Me.set_border(prices)
|
||||
|
|
@ -530,27 +553,19 @@ Sub build_json()
|
|||
Dim m As Object
|
||||
Dim list As Object
|
||||
|
||||
ReDim handler.basis(100)
|
||||
i = 2
|
||||
j = 0
|
||||
Do While shConfig.Cells(2, i) <> ""
|
||||
handler.basis(j) = shConfig.Cells(2, i)
|
||||
j = j + 1
|
||||
i = i + 1
|
||||
Loop
|
||||
ReDim Preserve handler.basis(j - 1)
|
||||
load_config
|
||||
|
||||
ReDim adjust(12)
|
||||
|
||||
If Me.newpart Then
|
||||
Set np = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
|
||||
Set np = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson()))
|
||||
np("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
|
||||
np("user") = Application.UserName
|
||||
np("scenario")("version") = handler.plan
|
||||
Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
|
||||
np("source") = "adj"
|
||||
np("type") = "new_basket"
|
||||
np("tag") = cbMTAG.text
|
||||
np("tag") = shMonthView.Range("MonthTags").value
|
||||
Set m = JsonConverter.ParseJson("{}")
|
||||
End If
|
||||
|
||||
|
|
@ -565,7 +580,7 @@ Sub build_json()
|
|||
Else
|
||||
'if something is changing
|
||||
If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then
|
||||
Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
|
||||
Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson()))
|
||||
'if there is no existing volume on the target month but units are being added
|
||||
If units(pos, 2) + units(pos, 3) = 0 And units(pos, 4) <> 0 Then
|
||||
'add month
|
||||
|
|
@ -692,26 +707,16 @@ Sub reset()
|
|||
End Sub
|
||||
|
||||
Sub switch_basket()
|
||||
|
||||
|
||||
If shConfig.Cells(6, 2) = 1 Then
|
||||
shConfig.Cells(6, 2) = 0
|
||||
Else
|
||||
shConfig.Cells(6, 2) = 1
|
||||
End If
|
||||
|
||||
shConfig.Range("show_basket").value = 1 - shConfig.Range("show_basket").value
|
||||
Call Me.print_basket
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub print_basket()
|
||||
|
||||
'SHCONFIG.Cells(6, 2) = 1
|
||||
If shConfig.Cells(6, 2) = 0 Then
|
||||
If shConfig.Range("show_basket").value = 0 Then
|
||||
dumping = True
|
||||
shMonthView.Range("B32:Q10000").ClearContents
|
||||
Rows("20:31").Hidden = False
|
||||
shMonthView.Range("basket").ClearContents
|
||||
' Rows("20:31").Hidden = False
|
||||
dumping = False
|
||||
Exit Sub
|
||||
End If
|
||||
|
|
@ -722,7 +727,7 @@ Sub print_basket()
|
|||
|
||||
dumping = True
|
||||
|
||||
shMonthView.Range("B32:Q10000").ClearContents
|
||||
shMonthView.Range("basket").ClearContents
|
||||
For i = 1 To UBound(basket, 1)
|
||||
shMonthView.Cells(31 + i, 2) = basket(i, 1)
|
||||
shMonthView.Cells(31 + i, 6) = basket(i, 2)
|
||||
|
|
@ -844,16 +849,29 @@ End Sub
|
|||
|
||||
|
||||
Sub post_adjust()
|
||||
|
||||
Dim i As Long
|
||||
Dim msg As String
|
||||
If Not Me.newpart Then
|
||||
msg = "Make sure at least one month has Final values for Volume, Price, and Sales."
|
||||
For i = 2 To 13
|
||||
If shMonthUpdate.Cells(i, 16) <> "" Then msg = ""
|
||||
Next i
|
||||
End If
|
||||
If IsEmpty(shMonthView.Range("MonthTags").value) Then msg = "You need to specify a tag for this update."
|
||||
|
||||
If msg <> "" Then
|
||||
MsgBox msg, vbOKOnly Or vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim fail As Boolean
|
||||
Dim adjust As Object
|
||||
Dim jdoc As String
|
||||
|
||||
If Me.newpart Then
|
||||
Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(2, 16))
|
||||
adjust("message") = Me.tbMCOM.text
|
||||
adjust("tag") = Me.cbMTAG.text
|
||||
adjust("message") = shMonthView.Range("MonthComment").value
|
||||
adjust("tag") = shMonthView.Range("MonthTags").value
|
||||
jdoc = JsonConverter.ConvertToJson(adjust)
|
||||
Call handler.request_adjust(jdoc, fail)
|
||||
If fail Then Exit Sub
|
||||
|
|
@ -861,8 +879,8 @@ Sub post_adjust()
|
|||
For i = 2 To 13
|
||||
If shMonthUpdate.Cells(i, 16) <> "" Then
|
||||
Set adjust = JsonConverter.ParseJson(shMonthUpdate.Cells(i, 16))
|
||||
adjust("message") = Me.tbMCOM.text
|
||||
adjust("tag") = Me.cbMTAG.text
|
||||
adjust("message") = shMonthView.Range("MonthComment").value
|
||||
adjust("tag") = shMonthView.Range("MonthTags").value
|
||||
jdoc = JsonConverter.ConvertToJson(adjust)
|
||||
Call handler.request_adjust(jdoc, fail)
|
||||
If fail Then Exit Sub
|
||||
|
|
@ -877,7 +895,7 @@ End Sub
|
|||
|
||||
Sub build_new()
|
||||
|
||||
shConfig.Cells(5, 2) = 1
|
||||
shConfig.Range("rebuild").value = 1
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim basket() As Variant
|
||||
|
|
@ -938,7 +956,7 @@ Sub new_part()
|
|||
|
||||
dumping = True
|
||||
|
||||
shMonthView.Range("B33:Q10000").ClearContents
|
||||
shMonthView.Range("basket").ClearContents
|
||||
|
||||
For i = 1 To UBound(cust, 2)
|
||||
shMonthView.Cells(32 + i, 2) = part.cbPart.value
|
||||
|
|
@ -947,7 +965,7 @@ Sub new_part()
|
|||
shMonthView.Cells(32 + i, 17) = CDbl(cust(2, i))
|
||||
Next i
|
||||
|
||||
shConfig.Cells(7, 2) = 1
|
||||
shConfig.Range("new_part").value = 1
|
||||
|
||||
'------copy revised basket to _month storage---------------------------------------------------
|
||||
|
||||
|
|
@ -980,7 +998,6 @@ Sub new_part()
|
|||
tprice = Range("H18:L18")
|
||||
tsales = Range("N18:R18")
|
||||
ReDim adjust(12)
|
||||
Set basejson = JsonConverter.ParseJson(shMonthUpdate.Range("P1").FormulaR1C1)
|
||||
For i = 1 To 12
|
||||
'volume
|
||||
units(i, 5) = units(i, 2)
|
||||
|
|
@ -1013,20 +1030,12 @@ Sub new_part()
|
|||
|
||||
|
||||
'force basket to show to demonstrate the part was changed
|
||||
shConfig.Cells(6, 2) = 1
|
||||
shConfig.Range("show_basket").value = 1
|
||||
Call Me.print_basket
|
||||
dumping = False
|
||||
|
||||
End Sub
|
||||
|
||||
Function newpart() As Boolean
|
||||
|
||||
If shConfig.Cells(7, 2) = 1 Then
|
||||
newpart = True
|
||||
Else
|
||||
newpart = False
|
||||
End If
|
||||
|
||||
newpart = shConfig.Range("new_part").value = 1
|
||||
End Function
|
||||
|
||||
|
||||
|
|
|
|||
148
VBA/shWalk.cls
148
VBA/shWalk.cls
|
|
@ -7,108 +7,108 @@ Attribute VB_GlobalNameSpace = False
|
|||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = True
|
||||
' Option Explicit
|
||||
'Option Explicit
|
||||
'
|
||||
' Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||
' Dim pt As PivotTable
|
||||
' Set pt = ActiveSheet.PivotTables("ptWalk")
|
||||
' Dim intersec As Range
|
||||
' Set intersec = Intersect(Target, pt.DataBodyRange)
|
||||
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||
' Dim pt As PivotTable
|
||||
' Set pt = ActiveSheet.PivotTables("ptWalk")
|
||||
' Dim intersec As Range
|
||||
' Set intersec = Intersect(Target, pt.DataBodyRange)
|
||||
'
|
||||
' If intersec Is Nothing Then
|
||||
' Exit Sub
|
||||
' ElseIf intersec.address <> Target.address Then
|
||||
' Exit Sub
|
||||
' End If
|
||||
' If intersec Is Nothing Then
|
||||
' Exit Sub
|
||||
' ElseIf intersec.address <> Target.address Then
|
||||
' Exit Sub
|
||||
' End If
|
||||
'
|
||||
' Cancel = True
|
||||
' Cancel = True
|
||||
'
|
||||
' Dim i As Long
|
||||
' Dim j As Long
|
||||
' Dim k As Long
|
||||
' Dim i As Long
|
||||
' Dim j As Long
|
||||
' Dim k As Long
|
||||
'
|
||||
' Dim ri As PivotItemList
|
||||
' Dim ci As PivotItemList
|
||||
' Dim df As Object
|
||||
' Dim rd As Object
|
||||
' Dim cd As Object
|
||||
' Dim dd As Object
|
||||
' Dim ri As PivotItemList
|
||||
' Dim ci As PivotItemList
|
||||
' Dim df As Object
|
||||
' Dim rd As Object
|
||||
' Dim cd As Object
|
||||
' Dim dd As Object
|
||||
'
|
||||
' Dim pf As PivotField
|
||||
' Dim pi As PivotItem
|
||||
' Dim pf As PivotField
|
||||
' Dim pi As PivotItem
|
||||
'
|
||||
' Set ri = Target.Cells.PivotCell.RowItems
|
||||
' Set ci = Target.Cells.PivotCell.ColumnItems
|
||||
' Set df = Target.Cells.PivotCell.DataField
|
||||
' Set ri = Target.Cells.PivotCell.RowItems
|
||||
' Set ci = Target.Cells.PivotCell.ColumnItems
|
||||
' Set df = Target.Cells.PivotCell.DataField
|
||||
'
|
||||
' Set rd = Target.Cells.PivotTable.RowFields
|
||||
' Set cd = Target.Cells.PivotTable.ColumnFields
|
||||
' Set rd = Target.Cells.PivotTable.RowFields
|
||||
' Set cd = Target.Cells.PivotTable.ColumnFields
|
||||
'
|
||||
' ReDim handler.sc(ri.Count, 1)
|
||||
' ReDim handler.sc(ri.Count, 1)
|
||||
'
|
||||
' handler.sql = ""
|
||||
' handler.jsql = ""
|
||||
' handler.sql = ""
|
||||
' handler.jsql = ""
|
||||
'
|
||||
' For i = 1 To ri.Count
|
||||
' If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
|
||||
' If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
|
||||
' handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'"
|
||||
' jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """"
|
||||
' handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
|
||||
' handler.sc(i - 1, 1) = ri(i).Name
|
||||
' Next i
|
||||
' For i = 1 To ri.Count
|
||||
' If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
|
||||
' If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
|
||||
' handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'"
|
||||
' jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """"
|
||||
' handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
|
||||
' handler.sc(i - 1, 1) = ri(i).Name
|
||||
' Next i
|
||||
'
|
||||
' scenario = "{" & handler.jsql & "}"
|
||||
' scenario = "{" & handler.jsql & "}"
|
||||
'
|
||||
' Call handler.load_config
|
||||
' Call handler.load_fpvt
|
||||
' Call handler.load_config
|
||||
' Call handler.load_fpvt
|
||||
'
|
||||
' End Sub
|
||||
'End Sub
|
||||
'
|
||||
' Function piv_pos(list As Object, target_pos As Long) As Long
|
||||
'Function piv_pos(list As Object, target_pos As Long) As Long
|
||||
'
|
||||
' Dim i As Long
|
||||
' Dim i As Long
|
||||
'
|
||||
' For i = 1 To list.Count
|
||||
' If list(i).Position = target_pos Then
|
||||
' piv_pos = i
|
||||
' Exit Function
|
||||
' End If
|
||||
' Next i
|
||||
' 'should not get to this point
|
||||
' For i = 1 To list.Count
|
||||
' If list(i).Position = target_pos Then
|
||||
' piv_pos = i
|
||||
' Exit Function
|
||||
' End If
|
||||
' Next i
|
||||
' 'should not get to this point
|
||||
'
|
||||
' End Function
|
||||
'End Function
|
||||
'
|
||||
' Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
|
||||
'Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
|
||||
'
|
||||
' Dim i As Integer
|
||||
' Dim i As Integer
|
||||
'
|
||||
' For i = 1 To pt.PivotFields.Count
|
||||
' If pt.PivotFields(i).Name = field_name Then
|
||||
' piv_fld_index = i
|
||||
' Exit Function
|
||||
' End If
|
||||
' Next i
|
||||
' For i = 1 To pt.PivotFields.Count
|
||||
' If pt.PivotFields(i).Name = field_name Then
|
||||
' piv_fld_index = i
|
||||
' Exit Function
|
||||
' End If
|
||||
' Next i
|
||||
'
|
||||
' End Function
|
||||
'End Function
|
||||
'
|
||||
' Function escape_json(ByVal text As String) As String
|
||||
'Function escape_json(ByVal text As String) As String
|
||||
'
|
||||
' text = Replace(text, "'", "''")
|
||||
' text = Replace(text, """", "\""")
|
||||
' If text = "(blank)" Then text = ""
|
||||
' escape_json = text
|
||||
' text = Replace(text, "'", "''")
|
||||
' text = Replace(text, """", "\""")
|
||||
' If text = "(blank)" Then text = ""
|
||||
' escape_json = text
|
||||
'
|
||||
' End Function
|
||||
'End Function
|
||||
'
|
||||
' Function escape_sql(ByVal text As String) As String
|
||||
'Function escape_sql(ByVal text As String) As String
|
||||
'
|
||||
' text = Replace(text, "'", "''")
|
||||
' text = Replace(text, """", """""")
|
||||
' If text = "(blank)" Then text = ""
|
||||
' escape_sql = text
|
||||
' text = Replace(text, "'", "''")
|
||||
' text = Replace(text, """", """""")
|
||||
' If text = "(blank)" Then text = ""
|
||||
' escape_sql = text
|
||||
'
|
||||
' End Function
|
||||
'End Function
|
||||
'
|
||||
'
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue