VBA/fpvt.frm
2019-03-01 15:49:59 -05:00

145 lines
4.7 KiB
Plaintext

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
Caption = "Forecast Adjustment"
ClientHeight = 7275
ClientLeft = 120
ClientTop = 465
ClientWidth = 13695
OleObjectBlob = "fpvt.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "fpvt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public mod_adjust As Boolean
Option Explicit
Private Sub cbCancel_Click()
tbAdjVol.value = 0
tbAdjVal.value = 0
tbAdjPrice.value = 0
fpvt.Hide
End Sub
Private Sub cbOK_Click()
'MsgBox (handler.scenario)
End Sub
Private Sub chbPlug_Change()
opvolume.Enabled = Not chbPlug.value
opprice.Enabled = Not chbPlug.value
End Sub
Private Sub opprice_Click()
tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value) + CDbl(tbAdjVal.value), "#,###")
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)), "#,###")
tbFcPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value), "#.000")
End Sub
Private Sub opvolume_Click()
Dim pchange As Double
'---------calculate percent change----------------------------------------------------------------------
pchange = 1 + CDbl(tbAdjVal.value) / (CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value))
'---------add the adjustments together to get the new forecast------------------------------------------
tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value) + CDbl(tbAdjVal.value), "#,###")
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)) * pchange, "#,###")
tbFcPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value), "#.000")
End Sub
Private Sub tbAdjVal_Change()
Dim pchange As Double
If IsNumeric(tbAdjVal.value) Then
'---------calculate percent change----------------------------------------------------------------------
pchange = 1 + CDbl(tbAdjVal.value) / (CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value))
'---------add the adjustments together to get the new forecast------------------------------------------
tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value) + CDbl(tbAdjVal.value), "#,###")
'---------if volume adjustment method is selected, scale the volume up----------------------------------
If opvolume Then
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)) * pchange, "#,###")
Else
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)), "#,###")
End If
tbFcPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value), "#.000")
Else
tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value), "#,###")
tbFcVol = Format((CDbl(tbPadjVol.value) + CDbl(tbBaseVol.value)), "#,###")
tbFcPrice = Format(CDbl(tbFcVal.value) / CDbl(tbFcVol.value), "#.000")
End If
End Sub
Private Sub tbAdjVol_Change()
If IsNumeric(tbAdjVol.value) Then
tbFcVol = Format(CDbl(tbAdjVol.value) + CDbl(tbBaseVol.value), "#,###")
Else
tbFcVol = Format(CDbl(tbBaseVol.value), "#,###")
End If
End Sub
Private Sub UserForm_Activate()
Dim s_tot As Object
Dim i As Long
Dim ok As Boolean
Set s_tot = handler.scenario_totals(handler.scenario, ok)
If Not ok Then
fpvt.Hide
Application.StatusBar = False
Exit Sub
End If
'---show existing adjustment if there is one----
fpvt.mod_adjust = False
For i = 1 To s_tot("x").Count
Select Case s_tot("x")(i)("order_season")
Case 2020
Select Case s_tot("x")(i)("iter")
Case "copy"
fpvt.tbBaseVol.Text = Format(s_tot("x")(i)("units"), "#,###")
fpvt.tbBaseVal.Text = Format(s_tot("x")(i)("value_usd"), "#,###")
If s_tot("x")(i)("units") <> 0 Then fpvt.tbBasePrice.Text = Format(s_tot("x")(i)("value_usd") / s_tot("x")(i)("units"), "#.000")
Case "adjustment"
fpvt.tbPadjVol.Text = Format(s_tot("x")(i)("units"), "#,###")
fpvt.tbPadjVal.Text = Format(s_tot("x")(i)("value_usd"), "#,###")
End Select
End Select
Next i
fpvt.tbFcVol.value = Format(CDbl(fpvt.tbBaseVol.value) + CDbl(fpvt.tbPadjVol.value), "#,###")
fpvt.tbFcVal.value = Format(CDbl(fpvt.tbBaseVal.value) + CDbl(fpvt.tbPadjVal.value), "#,###")
fpvt.tbFcPrice.value = Format(CDbl(fpvt.tbFcVal.value) / CDbl(fpvt.tbFcVol.value), "#.000")
Application.StatusBar = False
End Sub