307 lines
7.2 KiB
OpenEdge ABL
307 lines
7.2 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "months"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = True
|
|
Option Explicit
|
|
|
|
Private x As New TheBigOne
|
|
Private units() As Variant
|
|
Private price() As Variant
|
|
Private sales() As Variant
|
|
Private tunits() As Variant
|
|
Private tprice() As Variant
|
|
Private tsales() As Variant
|
|
Private dumping As Boolean
|
|
Private vedit As String
|
|
Private adjust() As Object
|
|
Private jtext() As Variant
|
|
Private basejson As Object
|
|
|
|
|
|
Private Sub Worksheet_Activate()
|
|
|
|
Call Me.load_sheet
|
|
|
|
End Sub
|
|
|
|
Private Sub Worksheet_Change(ByVal target As Range)
|
|
|
|
Application.Calculation = xlCalculationManual
|
|
If Not dumping Then
|
|
|
|
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
|
|
|
|
End If
|
|
|
|
'Call Me.set_format
|
|
Application.Calculation = xlCalculationAutomatic
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
Sub mvp_set()
|
|
|
|
Dim i As Integer
|
|
Call Me.get_sheet
|
|
|
|
For i = 1 To 12
|
|
If units(i, 5) = "" Then units(i, 5) = 0
|
|
If price(i, 5) = "" Then price(i, 5) = 0
|
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
|
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
|
sales(i, 5) = units(i, 5) * price(i, 5)
|
|
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
|
Next i
|
|
|
|
Me.crunch_array
|
|
Me.set_sheet
|
|
|
|
|
|
End Sub
|
|
|
|
Sub mvp_adj()
|
|
|
|
Dim i As Integer
|
|
Call Me.get_sheet
|
|
|
|
For i = 1 To 12
|
|
If units(i, 4) = "" Then units(i, 4) = 0
|
|
If price(i, 4) = "" Then price(i, 4) = 0
|
|
units(i, 5) = units(i, 4) + (units(i, 2) + units(i, 3))
|
|
price(i, 5) = price(i, 4) + (price(i, 2) + price(i, 3))
|
|
sales(i, 5) = units(i, 5) * price(i, 5)
|
|
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
|
Next i
|
|
|
|
Me.crunch_array
|
|
Me.set_sheet
|
|
|
|
|
|
End Sub
|
|
|
|
Sub ms_set()
|
|
|
|
Dim i As Integer
|
|
Call Me.get_sheet
|
|
|
|
For i = 1 To 12
|
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
|
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
|
sales(i, 5) = units(i, 5) * price(i, 5)
|
|
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
|
Next i
|
|
|
|
set_sheet
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
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")
|
|
ReDim adjust(12)
|
|
Set basejson = JsonConverter.ParseJson("{""scenario"":" & Sheets("_month").Range("P1").FormulaR1C1 & "}")
|
|
|
|
End Sub
|
|
|
|
Sub set_sheet()
|
|
|
|
dumping = True
|
|
|
|
Range("B6:F17") = units
|
|
Range("H6:L17") = price
|
|
Range("N6:R17") = sales
|
|
|
|
dumping = False
|
|
|
|
End Sub
|
|
|
|
Sub load_sheet()
|
|
|
|
units = Sheets("_month").Range("A2:E13").FormulaR1C1
|
|
price = Sheets("_month").Range("F2:J13").FormulaR1C1
|
|
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
|
|
|
|
|
|
End Sub
|
|
|
|
Sub set_format()
|
|
|
|
Dim prices As Range
|
|
Dim price_adj As Range
|
|
Dim price_set As Range
|
|
Dim vol As Range
|
|
Dim vol_adj As Range
|
|
Dim vol_set As Range
|
|
Dim val As Range
|
|
Dim val_adj As Range
|
|
Dim val_set As Range
|
|
|
|
Set prices = Sheets("month").Range("H6:L17")
|
|
Set price_adj = Sheets("month").Range("K6:K17")
|
|
Set price_set = Sheets("month").Range("L6:L17")
|
|
|
|
Set vol = Sheets("month").Range("B6:F17")
|
|
Set vol_adj = Sheets("month").Range("E6:E17")
|
|
Set vol_set = Sheets("month").Range("F6:F17")
|
|
|
|
Set val = Sheets("month").Range("N6:R17")
|
|
Set val_adj = Sheets("month").Range("Q6:Q17")
|
|
Set val_set = Sheets("month").Range("R6:R17")
|
|
|
|
Call Me.format_price(prices)
|
|
Call Me.set_border(prices)
|
|
Call Me.fill_yellow(price_adj)
|
|
Call Me.fill_none(price_set)
|
|
|
|
Call Me.format_number(vol)
|
|
Call Me.set_border(vol)
|
|
Call Me.fill_yellow(vol_adj)
|
|
Call Me.fill_none(vol_set)
|
|
|
|
Call Me.format_number(val)
|
|
Call Me.set_border(val)
|
|
Call Me.fill_yellow(val_adj)
|
|
Call Me.fill_none(val_set)
|
|
|
|
End Sub
|
|
|
|
Sub set_border(ByRef targ As Range)
|
|
|
|
targ.Borders(xlDiagonalDown).LineStyle = xlNone
|
|
targ.Borders(xlDiagonalUp).LineStyle = xlNone
|
|
With targ.Borders(xlEdgeLeft)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlEdgeTop)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlEdgeBottom)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlEdgeRight)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlInsideVertical)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
With targ.Borders(xlInsideHorizontal)
|
|
.LineStyle = xlContinuous
|
|
.ColorIndex = 0
|
|
.TintAndShade = 0
|
|
.Weight = xlThin
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub fill_yellow(ByRef target As Range)
|
|
|
|
With target.Interior
|
|
.Pattern = xlSolid
|
|
.PatternColorIndex = xlAutomatic
|
|
.ThemeColor = xlThemeColorAccent4
|
|
.TintAndShade = 0.799981688894314
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub fill_none(ByRef target As Range)
|
|
|
|
With target.Interior
|
|
.Pattern = xlNone
|
|
.TintAndShade = 0
|
|
.PatternTintAndShade = 0
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Sub format_price(ByRef target As Range)
|
|
|
|
target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
|
|
|
End Sub
|
|
|
|
Sub format_number(ByRef target As Range)
|
|
|
|
target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
|
|
|
End Sub
|
|
|
|
Sub build_json(ByVal pos As Integer)
|
|
|
|
'if there is no existing volume on the target month
|
|
If units(pos, 2) + units(pos, 3) = 0 Then
|
|
'add month
|
|
If price(pos, 4) = 0 Then
|
|
'if the target price is diferent from the average
|
|
adjust(pos)("type") = "addmonth_vd"
|
|
End If
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Sub crunch_array()
|
|
|
|
Dim i As Integer
|
|
|
|
For i = 1 To 5
|
|
tunits(1, i) = 0
|
|
tprice(1, i) = 0
|
|
tsales(1, i) = 0
|
|
Next i
|
|
|
|
For i = 1 To 12
|
|
tunits(1, 1) = tunits(1, 1) + units(i, 1)
|
|
tsales(1, 1) = tsales(1, 1) + sales(i, 1)
|
|
Next i
|
|
|
|
'prior
|
|
tprice(1, 1) = tsales(1, 1) / tunits(1, 1)
|
|
'base
|
|
tprice(2, 1) = tsales(2, 1) / tunits(2, 1)
|
|
'forecast
|
|
tprice(5, 1) = tsales(5, 1) / tunits(5, 1)
|
|
'adjust
|
|
tprice(3, 1) = (tsales(2, 1) + tsales(3, 1)) / (tunits(2, 1) + tunits(3, 1)) - tprice(2, 1)
|
|
'current adjust
|
|
tprice(4, 1) = tprice(5, 1) - (tprice(2, 1) + tprice(3, 1))
|
|
|
|
|
|
End Sub
|