432 lines
13 KiB
Plaintext
432 lines
13 KiB
Plaintext
VERSION 5.00
|
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} shipDateShifter
|
|
Caption = "Ship Date Shifting"
|
|
ClientHeight = 5205
|
|
ClientLeft = 120
|
|
ClientTop = 465
|
|
ClientWidth = 18375
|
|
OleObjectBlob = "shipDateShifter.frx":0000
|
|
StartUpPosition = 1 'CenterOwner
|
|
End
|
|
Attribute VB_Name = "shipDateShifter"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
Public selectedSeason As Integer
|
|
Public selectedMonth As Integer
|
|
Public currentValue As Double
|
|
Public numberFormat As String
|
|
|
|
Private Sub cmdCancel_Click()
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub cmdOK_Click()
|
|
Dim adjust As Object
|
|
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & ", ""distributions"":[]}")
|
|
adjust("scenario")("version") = handler.plan
|
|
adjust("scenario")("iter") = handler.basis
|
|
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
|
adjust("user") = Application.UserName
|
|
adjust("source") = "shift"
|
|
adjust("type") = "shift_ship_dates"
|
|
adjust("message") = txtComment.text
|
|
adjust("tag") = "Shift Shipping"
|
|
adjust("version") = handler.plan
|
|
|
|
Dim distribution As Object
|
|
Dim distributed As Double
|
|
Dim month As MSForms.TextBox
|
|
Dim m As Integer
|
|
For m = 1 To 12
|
|
Set month = txtMonth(selectedSeason, m)
|
|
If month.text <> "" Then
|
|
If m <> selectedMonth Then distributed = distributed + Val(RemoveFormat(month.text))
|
|
Set distribution = JsonConverter.ParseJson( _
|
|
"{""ship_season"":" & selectedSeason & "," & _
|
|
" ""ship_month"": """ & Me.Controls("lblShipMonth" & Format(m, "00")).Caption & """," & _
|
|
" ""pct"":" & Val(RemoveFormat(month.text)) / currentValue & _
|
|
"}")
|
|
adjust("distributions").Add distribution
|
|
End If
|
|
Next
|
|
|
|
For m = 1 To 12
|
|
Set month = txtMonth(selectedSeason + 1, m)
|
|
If month.text <> "" Then
|
|
distributed = distributed + Val(RemoveFormat(month.text))
|
|
Set distribution = JsonConverter.ParseJson( _
|
|
"{""ship_season"":" & selectedSeason + 1 & "," & _
|
|
" ""ship_month"": """ & Me.Controls("lblShipMonth" & Format(m, "00")).Caption & """," & _
|
|
" ""pct"":" & Val(RemoveFormat(month.text)) / currentValue & _
|
|
"}")
|
|
adjust("distributions").Add distribution
|
|
End If
|
|
Next
|
|
|
|
If distributed = 0 Then
|
|
MsgBox "No shifts were specified.", vbOKOnly + vbInformation
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim errorMsg As String
|
|
Dim json As Object
|
|
Set json = makeHttpRequest("POST", "shift_ship_dates", JsonConverter.ConvertToJson(adjust), errorMsg)
|
|
|
|
If errorMsg <> "" Then
|
|
MsgBox errorMsg, vbOKOnly + vbExclamation, "Couldn't shift the selected ship dates."
|
|
Exit Sub
|
|
End If
|
|
|
|
ReDim res(json("x").Count - 1, 34)
|
|
|
|
Dim i As Long
|
|
For i = 0 To UBound(res, 1)
|
|
res(i, 0) = json("x")(i + 1)("bill_cust_descr")
|
|
res(i, 1) = json("x")(i + 1)("billto_group")
|
|
res(i, 2) = json("x")(i + 1)("ship_cust_descr")
|
|
res(i, 3) = json("x")(i + 1)("shipto_group")
|
|
res(i, 4) = json("x")(i + 1)("quota_rep_descr")
|
|
res(i, 5) = json("x")(i + 1)("director")
|
|
res(i, 6) = json("x")(i + 1)("segm")
|
|
res(i, 7) = json("x")(i + 1)("substance")
|
|
res(i, 8) = json("x")(i + 1)("chan")
|
|
res(i, 9) = json("x")(i + 1)("chansub")
|
|
res(i, 10) = json("x")(i + 1)("part_descr")
|
|
res(i, 11) = json("x")(i + 1)("part_group")
|
|
res(i, 12) = json("x")(i + 1)("branding")
|
|
res(i, 13) = json("x")(i + 1)("majg_descr")
|
|
res(i, 14) = json("x")(i + 1)("ming_descr")
|
|
res(i, 15) = json("x")(i + 1)("majs_descr")
|
|
res(i, 16) = json("x")(i + 1)("mins_descr")
|
|
res(i, 17) = json("x")(i + 1)("order_season")
|
|
res(i, 18) = json("x")(i + 1)("order_month")
|
|
res(i, 19) = json("x")(i + 1)("ship_season")
|
|
res(i, 20) = json("x")(i + 1)("ship_month")
|
|
res(i, 21) = json("x")(i + 1)("request_season")
|
|
res(i, 22) = json("x")(i + 1)("request_month")
|
|
res(i, 23) = json("x")(i + 1)("promo")
|
|
res(i, 24) = json("x")(i + 1)("value_loc")
|
|
res(i, 25) = json("x")(i + 1)("value_usd")
|
|
res(i, 26) = json("x")(i + 1)("cost_loc")
|
|
res(i, 27) = json("x")(i + 1)("cost_usd")
|
|
res(i, 28) = json("x")(i + 1)("units")
|
|
res(i, 29) = json("x")(i + 1)("version")
|
|
res(i, 30) = json("x")(i + 1)("iter")
|
|
res(i, 31) = json("x")(i + 1)("logid")
|
|
res(i, 32) = json("x")(i + 1)("tag")
|
|
res(i, 33) = json("x")(i + 1)("comment")
|
|
res(i, 34) = json("x")(i + 1)("pounds")
|
|
Next i
|
|
|
|
errorMsg = ""
|
|
|
|
i = shData.UsedRange.Rows.Count + 1
|
|
Call Utils.SHTp_DumpVar(res, shData.Name, i, 1, False, False, True)
|
|
shShipments.PivotTables("ptShipments").PivotCache.Refresh
|
|
|
|
Unload Me
|
|
End Sub
|
|
|
|
Private Sub UserForm_Activate()
|
|
Me.Caption = "Ship Date Shifting " & shConfig.Range("version").value
|
|
|
|
Call Utils.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
|
|
|
|
With txtSelectedMonth
|
|
.text = Format(currentValue, numberFormat)
|
|
.BackColor = &H80000018
|
|
.Enabled = False
|
|
End With
|
|
UpdatePercentages
|
|
|
|
lblSeasonCurrent.Caption = selectedSeason
|
|
lblSeasonNext.Caption = selectedSeason + 1
|
|
End Sub
|
|
|
|
' Control Accessors
|
|
Private Function txtSelectedMonth() As MSForms.TextBox
|
|
Set txtSelectedMonth = txtMonth(selectedSeason, selectedMonth)
|
|
End Function
|
|
|
|
Private Function txtMonth(season As Integer, month As Integer) As MSForms.TextBox
|
|
Set txtMonth = Me.Controls("txt" & IIf(season = selectedSeason, "Current", "Next") & Format(month, "00"))
|
|
End Function
|
|
|
|
Private Function lblPctSelectedMonth() As MSForms.Label
|
|
Set lblPctSelectedMonth = lblPctMonth(selectedSeason, selectedMonth)
|
|
End Function
|
|
|
|
Private Function lblPctMonth(season As Integer, month As Integer) As MSForms.Label
|
|
Set lblPctMonth = Me.Controls("lblPct" & IIf(season = selectedSeason, "Current", "Next") & Format(month, "00"))
|
|
End Function
|
|
|
|
|
|
Private Sub RemoveFormatting(txtBx As MSForms.TextBox)
|
|
txtBx.text = RemoveFormat(txtBx.text)
|
|
End Sub
|
|
|
|
Private Function RemoveFormat(text As String)
|
|
RemoveFormat = Replace(Replace(text, "$", ""), ",", "")
|
|
End Function
|
|
|
|
Private Sub ApplyFormatting(txtBx As MSForms.TextBox)
|
|
txtBx.text = Format(txtBx.text, numberFormat)
|
|
End Sub
|
|
|
|
|
|
Private Function Recalculate(updated As MSForms.TextBox) As Boolean
|
|
Dim month As MSForms.TextBox
|
|
Dim distributed As Double
|
|
Dim before As Double
|
|
Dim m As Integer
|
|
For m = 1 To 12
|
|
Set month = txtMonth(selectedSeason, m)
|
|
If m < selectedMonth Then before = before + Val(RemoveFormat(month.text))
|
|
If m <> selectedMonth Then distributed = distributed + Val(RemoveFormat(month.text))
|
|
|
|
distributed = distributed + Val(RemoveFormat(txtMonth(selectedSeason + 1, m).text))
|
|
Next
|
|
|
|
Dim remaining As Double
|
|
remaining = Val(RemoveFormat(txtSelectedMonth.text))
|
|
|
|
If remaining = 0 And distributed > currentValue Then
|
|
MsgBox "You cannot shift more than you started with.", vbOKOnly + vbExclamation
|
|
Recalculate = True ' Failure. Set Cancel=True to stop leaving the textbox.
|
|
Exit Function
|
|
ElseIf distributed <= currentValue Then
|
|
txtSelectedMonth.text = currentValue - distributed
|
|
Else
|
|
updated.text = txtSelectedMonth.text
|
|
txtSelectedMonth.text = 0
|
|
End If
|
|
|
|
ApplyFormatting updated
|
|
ApplyFormatting txtSelectedMonth
|
|
lblWarning.Visible = before > 0
|
|
|
|
UpdatePercentages
|
|
|
|
Recalculate = False ' Success
|
|
End Function
|
|
|
|
Private Sub UpdatePercentages()
|
|
Dim m As Integer
|
|
For m = 1 To 12
|
|
If txtMonth(selectedSeason, m).text = "" Then
|
|
lblPctMonth(selectedSeason, m).Caption = ""
|
|
Else
|
|
lblPctMonth(selectedSeason, m).Caption = Format(txtMonth(selectedSeason, m).text / currentValue, "0%")
|
|
End If
|
|
If txtMonth(selectedSeason + 1, m).text = "" Then
|
|
lblPctMonth(selectedSeason + 1, m).Caption = ""
|
|
Else
|
|
lblPctMonth(selectedSeason + 1, m).Caption = Format(txtMonth(selectedSeason + 1, m).text / currentValue, "0%")
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
|
|
' Remove formatting before editing a textbox. After editing, restore formatting,
|
|
' and recalculate the selected month's value.
|
|
Private Sub txtCurrent01_Enter()
|
|
RemoveFormatting txtCurrent01
|
|
End Sub
|
|
|
|
Private Sub txtCurrent01_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent01)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent02_Enter()
|
|
RemoveFormatting txtCurrent02
|
|
End Sub
|
|
|
|
Private Sub txtCurrent02_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent02)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent03_Enter()
|
|
RemoveFormatting txtCurrent03
|
|
End Sub
|
|
|
|
Private Sub txtCurrent03_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent03)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent04_Enter()
|
|
RemoveFormatting txtCurrent04
|
|
End Sub
|
|
|
|
Private Sub txtCurrent04_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent04)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent05_Enter()
|
|
RemoveFormatting txtCurrent05
|
|
End Sub
|
|
|
|
Private Sub txtCurrent05_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent05)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent06_Enter()
|
|
RemoveFormatting txtCurrent06
|
|
End Sub
|
|
|
|
Private Sub txtCurrent06_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent06)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent07_Enter()
|
|
RemoveFormatting txtCurrent07
|
|
End Sub
|
|
|
|
Private Sub txtCurrent07_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent07)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent08_Enter()
|
|
RemoveFormatting txtCurrent08
|
|
End Sub
|
|
|
|
Private Sub txtCurrent08_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent08)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent09_Enter()
|
|
RemoveFormatting txtCurrent09
|
|
End Sub
|
|
|
|
Private Sub txtCurrent09_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent09)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent10_Enter()
|
|
RemoveFormatting txtCurrent10
|
|
End Sub
|
|
|
|
Private Sub txtCurrent10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent10)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent11_Enter()
|
|
RemoveFormatting txtCurrent11
|
|
End Sub
|
|
|
|
Private Sub txtCurrent11_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent11)
|
|
End Sub
|
|
|
|
Private Sub txtCurrent12_Enter()
|
|
RemoveFormatting txtCurrent12
|
|
End Sub
|
|
|
|
Private Sub txtCurrent12_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtCurrent12)
|
|
End Sub
|
|
|
|
Private Sub txtNext01_Enter()
|
|
RemoveFormatting txtNext01
|
|
End Sub
|
|
|
|
Private Sub txtNext01_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext01)
|
|
End Sub
|
|
|
|
Private Sub txtNext02_Enter()
|
|
RemoveFormatting txtNext02
|
|
End Sub
|
|
|
|
Private Sub txtNext02_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext02)
|
|
End Sub
|
|
|
|
Private Sub txtNext03_Enter()
|
|
RemoveFormatting txtNext03
|
|
End Sub
|
|
|
|
Private Sub txtNext03_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext03)
|
|
End Sub
|
|
|
|
Private Sub txtNext04_Enter()
|
|
RemoveFormatting txtNext04
|
|
End Sub
|
|
|
|
Private Sub txtNext04_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext04)
|
|
End Sub
|
|
|
|
Private Sub txtNext05_Enter()
|
|
RemoveFormatting txtNext05
|
|
End Sub
|
|
|
|
Private Sub txtNext05_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext05)
|
|
End Sub
|
|
|
|
Private Sub txtNext06_Enter()
|
|
RemoveFormatting txtNext06
|
|
End Sub
|
|
|
|
Private Sub txtNext06_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext06)
|
|
End Sub
|
|
|
|
Private Sub txtNext07_Enter()
|
|
RemoveFormatting txtNext07
|
|
End Sub
|
|
|
|
Private Sub txtNext07_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext07)
|
|
End Sub
|
|
|
|
Private Sub txtNext08_Enter()
|
|
RemoveFormatting txtNext08
|
|
End Sub
|
|
|
|
Private Sub txtNext08_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext08)
|
|
End Sub
|
|
|
|
Private Sub txtNext09_Enter()
|
|
RemoveFormatting txtNext09
|
|
End Sub
|
|
|
|
Private Sub txtNext09_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext09)
|
|
End Sub
|
|
|
|
Private Sub txtNext10_Enter()
|
|
RemoveFormatting txtNext10
|
|
End Sub
|
|
|
|
Private Sub txtNext10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext10)
|
|
End Sub
|
|
|
|
Private Sub txtNext11_Enter()
|
|
RemoveFormatting txtNext11
|
|
End Sub
|
|
|
|
Private Sub txtNext11_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext11)
|
|
End Sub
|
|
|
|
Private Sub txtNext12_Enter()
|
|
RemoveFormatting txtNext12
|
|
End Sub
|
|
|
|
Private Sub txtNext12_Exit(ByVal Cancel As MSForms.ReturnBoolean)
|
|
Cancel = Recalculate(txtNext12)
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|