Compare commits
No commits in common. "4b6d0c744dbb2ecde27d18c418e9c618a161679c" and "f546f7c7d1c8b904e5ecb5aa41d5f585c2d167e0" have entirely different histories.
4b6d0c744d
...
f546f7c7d1
1125
JsonConverter.bas
1125
JsonConverter.bas
File diff suppressed because it is too large
Load Diff
4966
TheBigOne.cls
4966
TheBigOne.cls
File diff suppressed because it is too large
Load Diff
78
build.frm
78
build.frm
@ -1,78 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build
|
|
||||||
Caption = "UserForm1"
|
|
||||||
ClientHeight = 3015
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 8100
|
|
||||||
OleObjectBlob = "build.frx":0000
|
|
||||||
StartUpPosition = 1 'CenterOwner
|
|
||||||
End
|
|
||||||
Attribute VB_Name = "build"
|
|
||||||
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
|
|
||||||
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
|
|
||||||
|
|
||||||
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()
|
|
||||||
|
|
||||||
useval = False
|
|
||||||
|
|
||||||
cbPart.value = part
|
|
||||||
cbBill.value = bill
|
|
||||||
cbShip.value = ship
|
|
||||||
|
|
||||||
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
|
|
||||||
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
|
|
||||||
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
53
changes.frm
53
changes.frm
@ -1,53 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
|
|
||||||
Caption = "History"
|
|
||||||
ClientHeight = 7740
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 16260
|
|
||||||
OleObjectBlob = "changes.frx":0000
|
|
||||||
StartUpPosition = 1 'CenterOwner
|
|
||||||
End
|
|
||||||
Attribute VB_Name = "changes"
|
|
||||||
Attribute VB_GlobalNameSpace = False
|
|
||||||
Attribute VB_Creatable = False
|
|
||||||
Attribute VB_PredeclaredId = True
|
|
||||||
Attribute VB_Exposed = False
|
|
||||||
Private x As Variant
|
|
||||||
|
|
||||||
Private Sub cbCancel_Click()
|
|
||||||
|
|
||||||
Me.Hide
|
|
||||||
|
|
||||||
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, 4)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub UserForm_Activate()
|
|
||||||
|
|
||||||
Dim fail As Boolean
|
|
||||||
|
|
||||||
x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
|
|
||||||
If fail Then
|
|
||||||
Me.Hide
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Me.lbHist.list = x
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
BIN
changes.frx
BIN
changes.frx
Binary file not shown.
929
fpvt.frm
929
fpvt.frm
@ -1,929 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
|
|
||||||
Caption = "Forecast Adjustment"
|
|
||||||
ClientHeight = 7350
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 7110
|
|
||||||
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
|
|
||||||
Private month() As Variant
|
|
||||||
Private mload() As Variant
|
|
||||||
Private adjust As Object
|
|
||||||
Private nomonth As Boolean
|
|
||||||
Private mline As Integer
|
|
||||||
Private clear_lb As Boolean
|
|
||||||
Private load_tb As Boolean
|
|
||||||
Private set_Price As Boolean
|
|
||||||
Private sp As Object
|
|
||||||
Private basket() As Variant
|
|
||||||
|
|
||||||
Private bVol As Double
|
|
||||||
Private bVal As Double
|
|
||||||
Private bPrc As Double
|
|
||||||
Private pVol As Double
|
|
||||||
Private pVal As Double
|
|
||||||
Private pPrc As Double
|
|
||||||
Private aVol As Double
|
|
||||||
Private aVal As Double
|
|
||||||
Private aPrc As Double
|
|
||||||
Private fVol As Double
|
|
||||||
Private fVal As Double
|
|
||||||
Private fPrc As Double
|
|
||||||
|
|
||||||
Private bVolm As Double
|
|
||||||
Private bValm As Double
|
|
||||||
Private bPrcm As Double
|
|
||||||
Private pVolm As Double
|
|
||||||
Private pValm As Double
|
|
||||||
Private pPrcm As Double
|
|
||||||
Private aVolm As Double
|
|
||||||
Private aValm As Double
|
|
||||||
Private aPrcm As Double
|
|
||||||
Private fVolm As Double
|
|
||||||
Private fValm As Double
|
|
||||||
Private fPrcm As Double
|
|
||||||
|
|
||||||
Option Explicit
|
|
||||||
|
|
||||||
Private Sub cbCancel_Click()
|
|
||||||
|
|
||||||
tbAdjVol.value = 0
|
|
||||||
tbAdjVal.value = 0
|
|
||||||
tbAdjPrice.value = 0
|
|
||||||
fpvt.Hide
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub butAdjust_Click()
|
|
||||||
|
|
||||||
Dim fail As Boolean
|
|
||||||
|
|
||||||
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
|
|
||||||
If fail Then
|
|
||||||
MsgBox ("adjustment was not made due to error")
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
Me.Hide
|
|
||||||
|
|
||||||
Set adjust = Nothing
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub butCancel_Click()
|
|
||||||
Me.Hide
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub butMAdjust_Click()
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
|
|
||||||
For i = 1 To 12
|
|
||||||
If month(i, 10) <> "" Then
|
|
||||||
Call handler.request_adjust(CStr(month(i, 10)))
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Me.Hide
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub butMCancel_Click()
|
|
||||||
|
|
||||||
Me.Hide
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub cbGoSheet_Click()
|
|
||||||
|
|
||||||
Me.Hide
|
|
||||||
Worksheets("month").Visible = xlSheetVisible
|
|
||||||
Sheets("month").Select
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub lbMonth_Change()
|
|
||||||
|
|
||||||
If clear_lb Or load_tb Then Exit Sub
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
For i = 0 To 13
|
|
||||||
If lbMonth.Selected(i) Then
|
|
||||||
mline = i
|
|
||||||
If i <> 0 And i <> 13 Then
|
|
||||||
Me.load_var
|
|
||||||
Me.load_mbox
|
|
||||||
Else
|
|
||||||
load_tb = True
|
|
||||||
tbMBaseVal.value = ""
|
|
||||||
tbMBaseVol.value = ""
|
|
||||||
tbMBasePrice.value = ""
|
|
||||||
tbmPAVal.value = ""
|
|
||||||
tbMPAVol.value = ""
|
|
||||||
tbMPAPrice.value = ""
|
|
||||||
tbMFVal.value = ""
|
|
||||||
tbMFVol.value = ""
|
|
||||||
tbMFPrice.value = ""
|
|
||||||
tbMAVal.value = ""
|
|
||||||
tbMAVol.value = ""
|
|
||||||
tbMAPrice.value = ""
|
|
||||||
load_tb = False
|
|
||||||
End If
|
|
||||||
Exit For
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub lheader_Click()
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub opEditPrice_Click()
|
|
||||||
|
|
||||||
opPlugVol.Enabled = False
|
|
||||||
opPlugPrice.Enabled = False
|
|
||||||
opPlugVol.Visible = False
|
|
||||||
opPlugPrice.Visible = False
|
|
||||||
opPlugPrice.value = True
|
|
||||||
opPlugVol.value = False
|
|
||||||
|
|
||||||
tbFcPrice.Enabled = True
|
|
||||||
tbFcPrice.BackColor = &H80000018
|
|
||||||
tbFcVal.Enabled = False
|
|
||||||
tbFcVal.BackColor = &H80000005
|
|
||||||
tbFcVol.Enabled = True
|
|
||||||
tbFcVol.BackColor = &H80000018
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub opEditSales_Click()
|
|
||||||
|
|
||||||
opPlugVol.Enabled = True
|
|
||||||
opPlugPrice.Enabled = True
|
|
||||||
opPlugVol.Visible = True
|
|
||||||
opPlugPrice.Visible = True
|
|
||||||
|
|
||||||
tbFcPrice.Enabled = False
|
|
||||||
tbFcPrice.BackColor = &H80000005
|
|
||||||
tbFcVal.Enabled = True
|
|
||||||
tbFcVal.BackColor = &H80000018
|
|
||||||
tbFcVol.Enabled = False
|
|
||||||
tbFcVol.BackColor = &H80000005
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub opEditPriceM_Click()
|
|
||||||
|
|
||||||
opmvol.Enabled = False
|
|
||||||
opmprice.Enabled = False
|
|
||||||
opmvol.Visible = False
|
|
||||||
opmprice.Visible = False
|
|
||||||
opmprice.value = True
|
|
||||||
opmvol.value = True
|
|
||||||
|
|
||||||
tbMFPrice.Enabled = True
|
|
||||||
tbMFPrice.BackColor = &H80000018
|
|
||||||
tbMFVal.Enabled = False
|
|
||||||
tbMFVal.BackColor = &H80000005
|
|
||||||
tbMFVol.Enabled = True
|
|
||||||
tbMFVol.BackColor = &H80000018
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub opEditSalesM_Click()
|
|
||||||
|
|
||||||
opmvol.Enabled = True
|
|
||||||
opmprice.Enabled = True
|
|
||||||
opmvol.Visible = True
|
|
||||||
opmprice.Visible = True
|
|
||||||
|
|
||||||
tbMFPrice.Enabled = False
|
|
||||||
tbMFPrice.BackColor = &H80000005
|
|
||||||
tbMFVal.Enabled = True
|
|
||||||
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
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub opPlugVol_Click()
|
|
||||||
calc_val
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub tbFcPrice_Change()
|
|
||||||
If load_tb Then Exit Sub
|
|
||||||
set_Price = True
|
|
||||||
If opEditPrice Then calc_price
|
|
||||||
set_Price = False
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub tbFcVal_Change()
|
|
||||||
If load_tb Then Exit Sub
|
|
||||||
If opEditSales Then calc_val
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub tbFcVol_Change()
|
|
||||||
If load_tb Then Exit Sub
|
|
||||||
If opEditPrice Then calc_price
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
'--------------------------------monthly buttons--------------------------------------
|
|
||||||
|
|
||||||
Private Sub opmPrice_Click()
|
|
||||||
calc_mval
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub opmVol_Click()
|
|
||||||
calc_mval
|
|
||||||
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 UserForm_Activate()
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
Dim j As Long
|
|
||||||
Dim k As Long
|
|
||||||
Dim ok As Boolean
|
|
||||||
|
|
||||||
Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
|
|
||||||
Me.mp.Visible = False
|
|
||||||
|
|
||||||
Me.lheader = "Loading..."
|
|
||||||
|
|
||||||
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
|
||||||
|
|
||||||
Me.lheader = "Ready"
|
|
||||||
|
|
||||||
If Not ok Then
|
|
||||||
fpvt.Hide
|
|
||||||
Application.StatusBar = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
|
|
||||||
'---show existing adjustment if there is one----
|
|
||||||
fpvt.mod_adjust = False
|
|
||||||
pVol = 0
|
|
||||||
pVal = 0
|
|
||||||
pPrc = 0
|
|
||||||
bVol = 0
|
|
||||||
bVal = 0
|
|
||||||
bPrc = 0
|
|
||||||
aVol = 0
|
|
||||||
aVal = 0
|
|
||||||
aPrc = 0
|
|
||||||
fVal = 0
|
|
||||||
fVol = 0
|
|
||||||
fPrc = 0
|
|
||||||
Me.tbAPI.value = ""
|
|
||||||
|
|
||||||
If IsNull(sp("package")("totals")) Then
|
|
||||||
fpvt.Hide
|
|
||||||
Application.StatusBar = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
For i = 1 To sp("package")("totals").Count
|
|
||||||
Select Case sp("package")("totals")(i)("order_season")
|
|
||||||
Case 2020
|
|
||||||
Select Case Me.iter_def(sp("package")("totals")(i)("iter"))
|
|
||||||
Case "baseline"
|
|
||||||
bVol = bVol + sp("package")("totals")(i)("units")
|
|
||||||
bVal = bVal + sp("package")("totals")(i)("value_usd")
|
|
||||||
If bVol <> 0 Then bPrc = bVal / bVol
|
|
||||||
|
|
||||||
Case "adjust"
|
|
||||||
pVol = pVol + sp("package")("totals")(i)("units")
|
|
||||||
pVal = pVal + sp("package")("totals")(i)("value_usd")
|
|
||||||
|
|
||||||
Case "exclude"
|
|
||||||
|
|
||||||
End Select
|
|
||||||
End Select
|
|
||||||
Next i
|
|
||||||
|
|
||||||
fVol = bVol + pVol
|
|
||||||
fVal = bVal + pVal
|
|
||||||
If fVol = 0 Then
|
|
||||||
fPrc = 0
|
|
||||||
Else
|
|
||||||
fPrc = fVal / fVol
|
|
||||||
End If
|
|
||||||
If (bVol + pVol) = 0 Then
|
|
||||||
pPrc = 0
|
|
||||||
Else
|
|
||||||
If bVol = 0 Then
|
|
||||||
pPrc = 0
|
|
||||||
Else
|
|
||||||
pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
If aVal <> 0 Then
|
|
||||||
MsgBox (aVal)
|
|
||||||
End If
|
|
||||||
Me.load_mbox_ann
|
|
||||||
|
|
||||||
'---------------------------------------populate monthly-------------------------------------------------------
|
|
||||||
|
|
||||||
k = 0
|
|
||||||
'--parse json into variant array for loading--
|
|
||||||
ReDim month(sp("package")("mpvt").Count + 1, 10)
|
|
||||||
|
|
||||||
For i = 1 To sp("package")("mpvt").Count
|
|
||||||
month(i, 0) = sp("package")("mpvt")(i)("order_month")
|
|
||||||
month(i, 1) = sp("package")("mpvt")(i)("2019 qty")
|
|
||||||
month(i, 2) = sp("package")("mpvt")(i)("2020 base qty")
|
|
||||||
month(i, 3) = sp("package")("mpvt")(i)("2020 adj qty")
|
|
||||||
month(i, 4) = sp("package")("mpvt")(i)("2020 tot qty")
|
|
||||||
month(i, 5) = sp("package")("mpvt")(i)("2019 value_usd")
|
|
||||||
month(i, 6) = sp("package")("mpvt")(i)("2020 base value_usd")
|
|
||||||
month(i, 7) = sp("package")("mpvt")(i)("2020 adj value_usd")
|
|
||||||
month(i, 8) = sp("package")("mpvt")(i)("2020 tot value_usd")
|
|
||||||
If co_num(month(i, 2), 0) = 0 Then
|
|
||||||
month(i, 9) = "addmonth"
|
|
||||||
Else
|
|
||||||
month(i, 9) = "scale"
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
month(0, 0) = "month"
|
|
||||||
month(13, 0) = "total"
|
|
||||||
month(0, 1) = "2019 qty"
|
|
||||||
month(0, 2) = "2020 base qty"
|
|
||||||
month(0, 3) = "2020 adj qty"
|
|
||||||
month(0, 4) = "2020 qty"
|
|
||||||
month(0, 5) = "2019 val"
|
|
||||||
month(0, 6) = "2020 base val"
|
|
||||||
month(0, 7) = "2020 adj val"
|
|
||||||
month(0, 8) = "2020 val"
|
|
||||||
|
|
||||||
Me.crunch_array
|
|
||||||
|
|
||||||
ReDim basket(sp("package")("basket").Count, 3)
|
|
||||||
|
|
||||||
' basket(0, 0) = "order_season"
|
|
||||||
' basket(0, 1) = "order_month"
|
|
||||||
' basket(0, 2) = "version"
|
|
||||||
' basket(0, 3) = "iter"
|
|
||||||
' basket(0, 4) = "part_descr"
|
|
||||||
' basket(0, 5) = "bill_cust_descr"
|
|
||||||
' basket(0, 6) = "ship_cust_descr"
|
|
||||||
' basket(0, 7) = "units"
|
|
||||||
' basket(0, 8) = "value_usd"
|
|
||||||
basket(0, 0) = "part_descr"
|
|
||||||
basket(0, 1) = "bill_cust_descr"
|
|
||||||
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")
|
|
||||||
'basket(i, 2) = sp("package")("base")(i)("version")
|
|
||||||
'basket(i, 3) = sp("package")("base")(i)("iter")
|
|
||||||
'basket(i, 4) = sp("package")("base")(i)("part_descr")
|
|
||||||
'basket(i, 5) = sp("package")("base")(i)("bill_cust_descr")
|
|
||||||
'basket(i, 6) = sp("package")("base")(i)("ship_cust_descr")
|
|
||||||
'basket(i, 7) = sp("package")("base")(i)("units")
|
|
||||||
'basket(i, 8) = sp("package")("base")(i)("value_usd")
|
|
||||||
basket(i, 0) = sp("package")("basket")(i)("part_descr")
|
|
||||||
basket(i, 1) = sp("package")("basket")(i)("bill_cust_descr")
|
|
||||||
basket(i, 2) = sp("package")("basket")(i)("ship_cust_descr")
|
|
||||||
basket(i, 3) = sp("package")("basket")(i)("mix")
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Call handler.month_tosheet(month, basket)
|
|
||||||
Application.StatusBar = False
|
|
||||||
|
|
||||||
Me.mp.Visible = True
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub crunch_array()
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
|
|
||||||
month(13, 1) = 0
|
|
||||||
month(13, 2) = 0
|
|
||||||
month(13, 3) = 0
|
|
||||||
month(13, 4) = 0
|
|
||||||
month(13, 5) = 0
|
|
||||||
month(13, 6) = 0
|
|
||||||
month(13, 7) = 0
|
|
||||||
month(13, 8) = 0
|
|
||||||
|
|
||||||
For i = 1 To 12
|
|
||||||
month(13, 1) = month(13, 1) + co_num(month(i, 1), 0)
|
|
||||||
month(13, 2) = month(13, 2) + co_num(month(i, 2), 0)
|
|
||||||
month(13, 3) = month(13, 3) + co_num(month(i, 3), 0)
|
|
||||||
month(13, 4) = month(13, 4) + co_num(month(i, 4), 0)
|
|
||||||
month(13, 5) = month(13, 5) + co_num(month(i, 5), 0)
|
|
||||||
month(13, 6) = month(13, 6) + co_num(month(i, 6), 0)
|
|
||||||
month(13, 7) = month(13, 7) + co_num(month(i, 7), 0)
|
|
||||||
month(13, 8) = month(13, 8) + co_num(month(i, 8), 0)
|
|
||||||
Next i
|
|
||||||
|
|
||||||
ReDim mload(UBound(month, 1), 5)
|
|
||||||
For i = 0 To UBound(month, 1)
|
|
||||||
mload(i, 0) = Format(month(i, 0), "#,###")
|
|
||||||
mload(i, 1) = Format(month(i, 1), "#,###")
|
|
||||||
mload(i, 2) = Format(month(i, 4), "#,###")
|
|
||||||
mload(i, 3) = Format(month(i, 5), "#,###")
|
|
||||||
mload(i, 4) = Format(month(i, 8), "#,###")
|
|
||||||
Next i
|
|
||||||
|
|
||||||
'mline = 0
|
|
||||||
clear_lb = True
|
|
||||||
lbMonth.clear
|
|
||||||
lbMonth.list = mload
|
|
||||||
clear_lb = False
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub load_var()
|
|
||||||
|
|
||||||
'base
|
|
||||||
bVolm = co_num(month(mline, 2), 0)
|
|
||||||
bValm = co_num(month(mline, 6), 0)
|
|
||||||
|
|
||||||
'prior adjust
|
|
||||||
pVolm = co_num(month(mline, 3), 0)
|
|
||||||
pValm = co_num(month(mline, 7), 0)
|
|
||||||
|
|
||||||
'current forecast
|
|
||||||
fVolm = co_num(month(mline, 4), 0)
|
|
||||||
fValm = co_num(month(mline, 8), 0)
|
|
||||||
|
|
||||||
'adjustment
|
|
||||||
aVolm = fVolm - (bVolm + pVolm)
|
|
||||||
aValm = fValm - (bValm + pValm)
|
|
||||||
|
|
||||||
|
|
||||||
If month(mline, 9) = "addmonth" Then
|
|
||||||
nomonth = True
|
|
||||||
bPrcm = month(13, 6) / month(13, 2)
|
|
||||||
fPrcm = month(13, 8) / month(13, 4)
|
|
||||||
|
|
||||||
Else
|
|
||||||
'prices
|
|
||||||
If bVolm <> 0 Then bPrcm = bValm / bVolm
|
|
||||||
If (bVolm + pVolm) <> 0 Then pPrcm = (pValm + bValm) / (bVolm + pVolm) - bPrcm
|
|
||||||
If fVolm <> 0 Then fPrcm = fValm / fVolm
|
|
||||||
aPrcm = fPrcm - (bPrcm + pPrcm)
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub load_mbox()
|
|
||||||
|
|
||||||
load_tb = True
|
|
||||||
|
|
||||||
tbMBaseVol = Format(bVolm, "#,###")
|
|
||||||
tbMBaseVal = Format(bValm, "#,###")
|
|
||||||
tbMBasePrice = Format(bPrcm, "0.000")
|
|
||||||
|
|
||||||
tbMPAVol = Format(pVolm, "#,###")
|
|
||||||
tbmPAVal = Format(pValm, "#,###")
|
|
||||||
tbMPAPrice = Format(pPrcm, "0.000")
|
|
||||||
|
|
||||||
tbMFVol = Format(fVolm, "#,###")
|
|
||||||
tbMFVal = Format(fValm, "#,###")
|
|
||||||
If Not set_Price Then tbMFPrice = Format(fPrcm, "0.###")
|
|
||||||
|
|
||||||
tbMAVol = Format(aVolm, "#,###")
|
|
||||||
tbMAVal = Format(aValm, "#,###")
|
|
||||||
tbMAPrice = Format(aPrcm, "0.000")
|
|
||||||
|
|
||||||
load_tb = False
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub load_mbox_ann()
|
|
||||||
|
|
||||||
load_tb = True
|
|
||||||
|
|
||||||
tbBaseVol = Format(bVol, "#,##0")
|
|
||||||
tbBaseVal = Format(bVal, "#,##0")
|
|
||||||
tbBasePrice = Format(bPrc, "0.000")
|
|
||||||
|
|
||||||
tbPadjVol = Format(pVol, "#,##0")
|
|
||||||
tbPadjVal = Format(pVal, "#,##0")
|
|
||||||
tbPadjPrice = Format(pPrc, "0.000")
|
|
||||||
|
|
||||||
tbFcVol = Format(fVol, "#,##0")
|
|
||||||
tbFcVal = Format(fVal, "#,##0")
|
|
||||||
If Not set_Price Then tbFcPrice = Format(fPrc, "0.000")
|
|
||||||
|
|
||||||
tbAdjVol = Format(aVol, "#,##0")
|
|
||||||
tbAdjVal = Format(aVal, "#,##0")
|
|
||||||
tbAdjPrice = Format(aPrc, "0.000")
|
|
||||||
|
|
||||||
load_tb = False
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub load_array()
|
|
||||||
|
|
||||||
'base
|
|
||||||
month(mline, 2) = bVolm
|
|
||||||
month(mline, 6) = bValm
|
|
||||||
|
|
||||||
'prior adjust
|
|
||||||
month(mline, 3) = pVolm
|
|
||||||
month(mline, 7) = pValm
|
|
||||||
|
|
||||||
'current forecast
|
|
||||||
month(mline, 4) = fVolm
|
|
||||||
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
|
|
||||||
co_num = two
|
|
||||||
Else
|
|
||||||
co_num = one
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Sub calc_val()
|
|
||||||
|
|
||||||
Dim pchange As Double
|
|
||||||
|
|
||||||
If IsNumeric(tbFcVal.value) Then
|
|
||||||
'get textbox value
|
|
||||||
fVal = tbFcVal.value
|
|
||||||
'do calculations
|
|
||||||
aVal = fVal - bVal - pVal
|
|
||||||
|
|
||||||
'---------if volume adjustment method is selected, scale the volume up----------------------------------
|
|
||||||
If opPlugVol Then
|
|
||||||
If (Round(pVal, 2) + Round(bVal, 2)) = 0 Then
|
|
||||||
pchange = 0
|
|
||||||
If co_num(pVal, bVal) = 0 Then
|
|
||||||
MsgBox ("a new part was added, and then adjusted to -0-")
|
|
||||||
Else
|
|
||||||
fVol = fVal / (co_num(bVal, pVal) / co_num(bVol, pVol))
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
pchange = fVal / (pVal + bVal)
|
|
||||||
fVol = (pVol + bVol) * pchange
|
|
||||||
End If
|
|
||||||
|
|
||||||
Else
|
|
||||||
fVol = pVol + bVol
|
|
||||||
End If
|
|
||||||
If fVol = 0 Then
|
|
||||||
fPrc = 0
|
|
||||||
Else
|
|
||||||
fPrc = fVal / fVol
|
|
||||||
End If
|
|
||||||
aVol = fVol - (bVol + pVol)
|
|
||||||
aPrc = fPrc - (bPrc + pPrc)
|
|
||||||
Else
|
|
||||||
aVol = fVol - bVol - pVol
|
|
||||||
aPrc = 0
|
|
||||||
|
|
||||||
End If
|
|
||||||
tbFcVal = Format(co_num(tbFcVal, 0), "#,##0")
|
|
||||||
|
|
||||||
Me.load_mbox_ann
|
|
||||||
|
|
||||||
'build json
|
|
||||||
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
|
||||||
adjust("scenario")("version") = "b20"
|
|
||||||
adjust("scenario")("iter") = handler.basis
|
|
||||||
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
|
||||||
adjust("user") = Application.UserName
|
|
||||||
adjust("source") = "adj"
|
|
||||||
If opEditSales Then
|
|
||||||
If opPlugVol Then
|
|
||||||
adjust("type") = "scale_v"
|
|
||||||
adjust("amount") = aVal
|
|
||||||
adjust("qty") = aVol
|
|
||||||
Else
|
|
||||||
adjust("type") = "scale_p"
|
|
||||||
adjust("amount") = aVal
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
adjust("type") = "scale_vp"
|
|
||||||
adjust("qty") = aVol
|
|
||||||
adjust("amount") = aVal
|
|
||||||
End If
|
|
||||||
|
|
||||||
'print json
|
|
||||||
tbAPI = JsonConverter.ConvertToJson(adjust)
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub calc_price()
|
|
||||||
|
|
||||||
'If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
|
|
||||||
'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
|
|
||||||
|
|
||||||
'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) Then
|
|
||||||
'capture currently changed item
|
|
||||||
|
|
||||||
fVol = co_num(tbFcVol.value, 0)
|
|
||||||
fPrc = co_num(tbFcPrice.value, 0)
|
|
||||||
'calc
|
|
||||||
fVal = fPrc * fVol
|
|
||||||
aVal = fVal - bVal - pVal
|
|
||||||
aVol = fVol - (bVol + pVol)
|
|
||||||
|
|
||||||
If (bVol + pVol) = 0 Then
|
|
||||||
aPrc = 0
|
|
||||||
Else
|
|
||||||
'aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
|
|
||||||
aPrc = fPrc - (bPrc + pPrc)
|
|
||||||
End If
|
|
||||||
'End If
|
|
||||||
|
|
||||||
Me.load_mbox_ann
|
|
||||||
|
|
||||||
'build json
|
|
||||||
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
|
||||||
adjust("scenario")("version") = "b20"
|
|
||||||
adjust("scenario")("iter") = handler.basis
|
|
||||||
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
|
||||||
adjust("user") = Application.UserName
|
|
||||||
adjust("source") = "adj"
|
|
||||||
adjust("version") = "b20"
|
|
||||||
|
|
||||||
If opEditSales Then
|
|
||||||
If opPlugVol Then
|
|
||||||
adjust("type") = "scale_v"
|
|
||||||
adjust("amount") = aVal
|
|
||||||
Else
|
|
||||||
adjust("type") = "scale_p"
|
|
||||||
adjust("amount") = aVal
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
If aVol = 0 Then
|
|
||||||
adjust("type") = "scale_p"
|
|
||||||
Else
|
|
||||||
adjust("type") = "scale_vp"
|
|
||||||
End If
|
|
||||||
adjust("qty") = aVol
|
|
||||||
adjust("amount") = aVal
|
|
||||||
End If
|
|
||||||
|
|
||||||
'print json
|
|
||||||
tbAPI = JsonConverter.ConvertToJson(adjust)
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Sub calc_mval()
|
|
||||||
|
|
||||||
Dim pchange As Double
|
|
||||||
Dim j As Object
|
|
||||||
|
|
||||||
If IsNumeric(tbMFVal.value) Then
|
|
||||||
'get textbox value
|
|
||||||
fValm = tbMFVal.value
|
|
||||||
'do calculations
|
|
||||||
aValm = fValm - bValm - pValm
|
|
||||||
|
|
||||||
'---------if volume adjustment method is selected, scale the volume up----------------------------------
|
|
||||||
If nomonth Then
|
|
||||||
fVolm = fValm / bPrcm
|
|
||||||
fPrcm = bPrcm
|
|
||||||
Else
|
|
||||||
If opmvol Then
|
|
||||||
pchange = fValm / (pValm + bValm)
|
|
||||||
fVolm = (pVolm + bVolm) * pchange
|
|
||||||
Else
|
|
||||||
fVolm = pVolm + bVolm
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
If fVolm = 0 Then
|
|
||||||
fPrcm = 0
|
|
||||||
Else
|
|
||||||
fPrcm = fValm / fVolm
|
|
||||||
End If
|
|
||||||
aVolm = fVolm - (bVolm + pVolm)
|
|
||||||
aPrcm = fPrcm - (bPrcm + pPrcm)
|
|
||||||
Else
|
|
||||||
aVolm = fVolm - bVolm - pVolm
|
|
||||||
aPrcm = 0
|
|
||||||
End If
|
|
||||||
tbMFVal = Format(tbMFVal, "#,###")
|
|
||||||
|
|
||||||
'build json
|
|
||||||
|
|
||||||
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
|
||||||
j("scenario")("version") = "b20"
|
|
||||||
j("scenario")("iter") = handler.basis
|
|
||||||
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
|
||||||
j("user") = Application.UserName
|
|
||||||
j("source") = "adj"
|
|
||||||
If opEditSalesM Then
|
|
||||||
If opmvol Then
|
|
||||||
If nomonth Then
|
|
||||||
j("type") = "addmonth_v"
|
|
||||||
j("month") = month(mline, 0)
|
|
||||||
Else
|
|
||||||
j("type") = "scale_v"
|
|
||||||
j("scenario")("order_month") = month(mline, 0)
|
|
||||||
End If
|
|
||||||
j("amount") = aValm
|
|
||||||
Else
|
|
||||||
If nomonth Then
|
|
||||||
j("type") = "addmonth_p"
|
|
||||||
j("month") = month(mline, 0)
|
|
||||||
Else
|
|
||||||
j("type") = "scale_p"
|
|
||||||
j("scenario")("order_month") = month(mline, 0)
|
|
||||||
End If
|
|
||||||
j("amount") = aValm
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
If nomonth Then
|
|
||||||
j("type") = "addmonth_vp"
|
|
||||||
j("month") = month(mline, 0)
|
|
||||||
Else
|
|
||||||
j("type") = "scale_vp"
|
|
||||||
j("scenario")("order_month") = month(mline, 0)
|
|
||||||
End If
|
|
||||||
j("qty") = aVolm
|
|
||||||
j("amount") = aValm
|
|
||||||
End If
|
|
||||||
|
|
||||||
month(mline, 10) = JsonConverter.ConvertToJson(j)
|
|
||||||
tbAPI = JsonConverter.ConvertToJson(j)
|
|
||||||
|
|
||||||
Me.load_mbox
|
|
||||||
Me.load_array
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub calc_mprice()
|
|
||||||
|
|
||||||
Dim j As Object
|
|
||||||
|
|
||||||
If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then
|
|
||||||
'capture currently changed item
|
|
||||||
fVolm = tbMFVol.value
|
|
||||||
fPrcm = tbMFPrice.value
|
|
||||||
'calc
|
|
||||||
fValm = fPrcm * fVolm
|
|
||||||
aValm = fValm - bValm - pValm
|
|
||||||
aVolm = fVolm - (bVolm + pVolm)
|
|
||||||
If nomonth Then
|
|
||||||
aPrcm = fValm / fVolm - bPrcm
|
|
||||||
Else
|
|
||||||
aPrcm = fValm / fVolm - ((bValm + pValm) / (bVolm + pVolm))
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
fValm = 0
|
|
||||||
aValm = fValm - bValm - pValm
|
|
||||||
End If
|
|
||||||
|
|
||||||
'build json
|
|
||||||
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
|
||||||
j("scenario")("version") = "b20"
|
|
||||||
j("scenario")("iter") = handler.basis
|
|
||||||
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
|
||||||
j("user") = Application.UserName
|
|
||||||
j("source") = "adj"
|
|
||||||
If opEditSalesM Then
|
|
||||||
If opmvol Then
|
|
||||||
If nomonth Then
|
|
||||||
j("type") = "addmonth_v"
|
|
||||||
j("month") = month(mline, 0)
|
|
||||||
Else
|
|
||||||
j("type") = "scale_v"
|
|
||||||
j("scenario")("order_month") = month(mline, 0)
|
|
||||||
End If
|
|
||||||
j("amount") = aValm
|
|
||||||
Else
|
|
||||||
If nomonth Then
|
|
||||||
'this scenario should be prevented
|
|
||||||
j("type") = "addmonth_v"
|
|
||||||
j("month") = month(mline, 0)
|
|
||||||
Else
|
|
||||||
j("type") = "scale_p"
|
|
||||||
j("scenario")("order_month") = month(mline, 0)
|
|
||||||
End If
|
|
||||||
j("amount") = aValm
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
If nomonth Then
|
|
||||||
j("type") = "addmonth_vp"
|
|
||||||
j("month") = month(mline, 0)
|
|
||||||
Else
|
|
||||||
If aVolm = 0 Then
|
|
||||||
j("type") = "scale_p"
|
|
||||||
Else
|
|
||||||
j("type") = "scale_vp"
|
|
||||||
End If
|
|
||||||
j("scenario")("order_month") = month(mline, 0)
|
|
||||||
End If
|
|
||||||
j("qty") = aVolm
|
|
||||||
j("amount") = aValm
|
|
||||||
End If
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
|
|
||||||
For i = 0 To UBound(handler.baseline)
|
|
||||||
If handler.baseline(i) = iter Then
|
|
||||||
iter_def = "baseline"
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
For i = 0 To UBound(handler.adjust)
|
|
||||||
If handler.adjust(i) = iter Then
|
|
||||||
iter_def = "adjust"
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
iter_def = "exclude"
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Sub new_part()
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
519
handler.bas
519
handler.bas
@ -1,519 +0,0 @@
|
|||||||
Attribute VB_Name = "handler"
|
|
||||||
Option Explicit
|
|
||||||
|
|
||||||
Public sql As String
|
|
||||||
Public jsql As String
|
|
||||||
Public scenario As String
|
|
||||||
Public sc() As Variant
|
|
||||||
Public x As New TheBigOne
|
|
||||||
Public wapi As New Windows_API
|
|
||||||
Public data() As String
|
|
||||||
Public agg() As String
|
|
||||||
Public showprice As Boolean
|
|
||||||
Public server As String
|
|
||||||
Public basis() As Variant
|
|
||||||
Public baseline() As Variant
|
|
||||||
Public adjust() As Variant
|
|
||||||
|
|
||||||
|
|
||||||
Sub load_fpvt()
|
|
||||||
|
|
||||||
Application.StatusBar = "retrieving selection data....."
|
|
||||||
|
|
||||||
'data = x.SHTp_Get("data", 1, 1, True)
|
|
||||||
'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30))
|
|
||||||
Dim i As Long
|
|
||||||
Dim s_tot As Object
|
|
||||||
|
|
||||||
fpvt.ListBox1.list = handler.sc
|
|
||||||
|
|
||||||
showprice = False
|
|
||||||
|
|
||||||
For i = 0 To UBound(handler.sc, 1)
|
|
||||||
If handler.sc(i, 0) = "part_descr" Then
|
|
||||||
showprice = True
|
|
||||||
Exit For
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
|
|
||||||
fpvt.Show
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Function scenario_package(doc As String, ByRef status As Boolean) As Object
|
|
||||||
|
|
||||||
Dim req As New WinHttp.WinHttpRequest
|
|
||||||
Dim json As Object
|
|
||||||
Dim wr As String
|
|
||||||
|
|
||||||
On Error GoTo errh
|
|
||||||
|
|
||||||
With req
|
|
||||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
|
||||||
.Open "GET", server & "/scenario_package", True
|
|
||||||
.SetRequestHeader "Content-Type", "application/json"
|
|
||||||
.Send doc
|
|
||||||
.WaitForResponse
|
|
||||||
wr = .ResponseText
|
|
||||||
End With
|
|
||||||
|
|
||||||
Set json = JsonConverter.ParseJson(wr)
|
|
||||||
Set scenario_package = json
|
|
||||||
|
|
||||||
errh:
|
|
||||||
If Err.Number <> 0 Then
|
|
||||||
status = False
|
|
||||||
MsgBox (Err.Description)
|
|
||||||
Set scenario_package = Nothing
|
|
||||||
Else
|
|
||||||
status = True
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Sub pg_main_workset(rep As String)
|
|
||||||
|
|
||||||
Dim req As New WinHttp.WinHttpRequest
|
|
||||||
Dim wapi As New Windows_API
|
|
||||||
Dim wr As String
|
|
||||||
Dim json As Object
|
|
||||||
Dim i As Long
|
|
||||||
Dim j As Long
|
|
||||||
Dim doc As String
|
|
||||||
Dim res() As Variant
|
|
||||||
Dim str() As String
|
|
||||||
|
|
||||||
doc = "{""quota_rep"":""" & rep & """}"
|
|
||||||
|
|
||||||
With req
|
|
||||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
|
||||||
.Open "GET", handler.server & "/get_pool", True
|
|
||||||
.SetRequestHeader "Content-Type", "application/json"
|
|
||||||
.Send doc
|
|
||||||
.WaitForResponse
|
|
||||||
wr = .ResponseText
|
|
||||||
End With
|
|
||||||
|
|
||||||
Set json = JsonConverter.ParseJson(wr)
|
|
||||||
ReDim res(json("x").Count, 32)
|
|
||||||
|
|
||||||
For i = 1 To UBound(res, 1)
|
|
||||||
res(i, 0) = json("x")(i)("bill_cust_descr")
|
|
||||||
res(i, 1) = json("x")(i)("billto_group")
|
|
||||||
res(i, 2) = json("x")(i)("ship_cust_descr")
|
|
||||||
res(i, 3) = json("x")(i)("shipto_group")
|
|
||||||
res(i, 4) = json("x")(i)("quota_rep_descr")
|
|
||||||
res(i, 5) = json("x")(i)("director_descr")
|
|
||||||
res(i, 6) = json("x")(i)("segm")
|
|
||||||
res(i, 7) = json("x")(i)("mod_chan")
|
|
||||||
res(i, 8) = json("x")(i)("mod_chansub")
|
|
||||||
res(i, 9) = json("x")(i)("majg_descr")
|
|
||||||
res(i, 10) = json("x")(i)("ming_descr")
|
|
||||||
res(i, 11) = json("x")(i)("majs_descr")
|
|
||||||
res(i, 12) = json("x")(i)("mins_descr")
|
|
||||||
res(i, 13) = json("x")(i)("brand")
|
|
||||||
res(i, 14) = json("x")(i)("part_family")
|
|
||||||
res(i, 15) = json("x")(i)("part_group")
|
|
||||||
res(i, 16) = json("x")(i)("branding")
|
|
||||||
res(i, 17) = json("x")(i)("color")
|
|
||||||
res(i, 18) = json("x")(i)("part_descr")
|
|
||||||
res(i, 19) = json("x")(i)("order_season")
|
|
||||||
res(i, 20) = json("x")(i)("order_month")
|
|
||||||
res(i, 21) = json("x")(i)("ship_season")
|
|
||||||
res(i, 22) = json("x")(i)("ship_month")
|
|
||||||
res(i, 23) = json("x")(i)("request_season")
|
|
||||||
res(i, 24) = json("x")(i)("request_month")
|
|
||||||
res(i, 25) = json("x")(i)("promo")
|
|
||||||
res(i, 26) = json("x")(i)("version")
|
|
||||||
res(i, 27) = json("x")(i)("iter")
|
|
||||||
res(i, 28) = json("x")(i)("value_loc")
|
|
||||||
res(i, 29) = json("x")(i)("value_usd")
|
|
||||||
res(i, 30) = json("x")(i)("cost_loc")
|
|
||||||
res(i, 31) = json("x")(i)("cost_usd")
|
|
||||||
res(i, 32) = json("x")(i)("units")
|
|
||||||
Next i
|
|
||||||
|
|
||||||
res(0, 0) = "bill_cust_descr"
|
|
||||||
res(0, 1) = "billto_group"
|
|
||||||
res(0, 2) = "ship_cust_descr"
|
|
||||||
res(0, 3) = "shipto_group"
|
|
||||||
res(0, 4) = "quota_rep_descr"
|
|
||||||
res(0, 5) = "director_descr"
|
|
||||||
res(0, 6) = "segm"
|
|
||||||
res(0, 7) = "mod_chan"
|
|
||||||
res(0, 8) = "mod_chansub"
|
|
||||||
res(0, 9) = "majg_descr"
|
|
||||||
res(0, 10) = "ming_descr"
|
|
||||||
res(0, 11) = "majs_descr"
|
|
||||||
res(0, 12) = "mins_descr"
|
|
||||||
res(0, 13) = "brand"
|
|
||||||
res(0, 14) = "part_family"
|
|
||||||
res(0, 15) = "part_group"
|
|
||||||
res(0, 16) = "branding"
|
|
||||||
res(0, 17) = "color"
|
|
||||||
res(0, 18) = "part_descr"
|
|
||||||
res(0, 19) = "order_season"
|
|
||||||
res(0, 20) = "order_month"
|
|
||||||
res(0, 21) = "ship_season"
|
|
||||||
res(0, 22) = "ship_month"
|
|
||||||
res(0, 23) = "request_season"
|
|
||||||
res(0, 24) = "request_month"
|
|
||||||
res(0, 25) = "promo"
|
|
||||||
res(0, 26) = "version"
|
|
||||||
res(0, 27) = "iter"
|
|
||||||
res(0, 28) = "value_loc"
|
|
||||||
res(0, 29) = "value_usd"
|
|
||||||
res(0, 30) = "cost_loc"
|
|
||||||
res(0, 31) = "cost_usd"
|
|
||||||
res(0, 32) = "units"
|
|
||||||
|
|
||||||
Set json = Nothing
|
|
||||||
|
|
||||||
ReDim str(UBound(res, 1), UBound(res, 2))
|
|
||||||
|
|
||||||
Worksheets("data").Cells.ClearContents
|
|
||||||
Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub pull_rep()
|
|
||||||
|
|
||||||
openf.Show
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
|
||||||
|
|
||||||
Dim req As New WinHttp.WinHttpRequest
|
|
||||||
Dim json As Object
|
|
||||||
Dim wr As String
|
|
||||||
Dim i As Long
|
|
||||||
Dim j As Long
|
|
||||||
Dim str() As String
|
|
||||||
|
|
||||||
If doc = "" Then
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
'update timestamp
|
|
||||||
Set json = JsonConverter.ParseJson(doc)
|
|
||||||
'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
|
|
||||||
'doc = JsonConverter.ConvertToJson(doc)
|
|
||||||
|
|
||||||
server = Sheets("config").Cells(1, 2)
|
|
||||||
|
|
||||||
With req
|
|
||||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
|
||||||
.Open "POST", server & "/" & json("type"), True
|
|
||||||
.SetRequestHeader "Content-Type", "application/json"
|
|
||||||
.Send doc
|
|
||||||
.WaitForResponse
|
|
||||||
wr = .ResponseText
|
|
||||||
End With
|
|
||||||
|
|
||||||
If Mid(wr, 2, 5) = "error" Then
|
|
||||||
MsgBox (wr)
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
If Mid(wr, 1, 6) = "<body>" Then
|
|
||||||
MsgBox (wr)
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
If Mid(wr, 1, 6) = "<!DOCT" Then
|
|
||||||
MsgBox (wr)
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
Set json = JsonConverter.ParseJson(wr)
|
|
||||||
|
|
||||||
If IsNull(json("x")) Then
|
|
||||||
MsgBox ("no adjustment was made")
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
ReDim res(json("x").Count - 1, 32)
|
|
||||||
|
|
||||||
For i = 1 To UBound(res, 1) + 1
|
|
||||||
res(i - 1, 0) = json("x")(i)("bill_cust_descr")
|
|
||||||
res(i - 1, 1) = json("x")(i)("billto_group")
|
|
||||||
res(i - 1, 2) = json("x")(i)("ship_cust_descr")
|
|
||||||
res(i - 1, 3) = json("x")(i)("shipto_group")
|
|
||||||
res(i - 1, 4) = json("x")(i)("quota_rep_descr")
|
|
||||||
res(i - 1, 5) = json("x")(i)("director_descr")
|
|
||||||
res(i - 1, 6) = json("x")(i)("segm")
|
|
||||||
res(i - 1, 7) = json("x")(i)("mod_chan")
|
|
||||||
res(i - 1, 8) = json("x")(i)("mod_chansub")
|
|
||||||
res(i - 1, 9) = json("x")(i)("majg_descr")
|
|
||||||
res(i - 1, 10) = json("x")(i)("ming_descr")
|
|
||||||
res(i - 1, 11) = json("x")(i)("majs_descr")
|
|
||||||
res(i - 1, 12) = json("x")(i)("mins_descr")
|
|
||||||
res(i - 1, 13) = json("x")(i)("brand")
|
|
||||||
res(i - 1, 14) = json("x")(i)("part_family")
|
|
||||||
res(i - 1, 15) = json("x")(i)("part_group")
|
|
||||||
res(i - 1, 16) = json("x")(i)("branding")
|
|
||||||
res(i - 1, 17) = json("x")(i)("color")
|
|
||||||
res(i - 1, 18) = json("x")(i)("part_descr")
|
|
||||||
res(i - 1, 19) = json("x")(i)("order_season")
|
|
||||||
res(i - 1, 20) = json("x")(i)("order_month")
|
|
||||||
res(i - 1, 21) = json("x")(i)("ship_season")
|
|
||||||
res(i - 1, 22) = json("x")(i)("ship_month")
|
|
||||||
res(i - 1, 23) = json("x")(i)("request_season")
|
|
||||||
res(i - 1, 24) = json("x")(i)("request_month")
|
|
||||||
res(i - 1, 25) = json("x")(i)("promo")
|
|
||||||
res(i - 1, 26) = json("x")(i)("version")
|
|
||||||
res(i - 1, 27) = json("x")(i)("iter")
|
|
||||||
res(i - 1, 28) = json("x")(i)("value_loc")
|
|
||||||
res(i - 1, 29) = json("x")(i)("value_usd")
|
|
||||||
res(i - 1, 30) = json("x")(i)("cost_loc")
|
|
||||||
res(i - 1, 31) = json("x")(i)("cost_usd")
|
|
||||||
res(i - 1, 32) = json("x")(i)("units")
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Set json = Nothing
|
|
||||||
|
|
||||||
ReDim str(UBound(res, 1), UBound(res, 2))
|
|
||||||
|
|
||||||
' For i = 0 To UBound(res, 1)
|
|
||||||
' For j = 0 To UBound(res, 2)
|
|
||||||
' If IsNull(res(i, j)) Then
|
|
||||||
' str(i, j) = ""
|
|
||||||
' Else
|
|
||||||
' str(i, j) = res(i, j)
|
|
||||||
' End If
|
|
||||||
' Next j
|
|
||||||
' Next i
|
|
||||||
|
|
||||||
i = 1
|
|
||||||
Do Until Sheets("data").Cells(i, 1) = ""
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
|
|
||||||
Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
|
|
||||||
|
|
||||||
|
|
||||||
'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
|
|
||||||
|
|
||||||
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Sub load_config()
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
Dim j As Integer
|
|
||||||
'----server to use---------------------------------------------------------
|
|
||||||
handler.server = Sheets("config").Cells(1, 2)
|
|
||||||
'---basis-----------------------------------------------------------------
|
|
||||||
ReDim handler.basis(100)
|
|
||||||
i = 2
|
|
||||||
j = 0
|
|
||||||
Do While Sheets("config").Cells(2, i) <> ""
|
|
||||||
handler.basis(j) = Sheets("config").Cells(2, i)
|
|
||||||
j = j + 1
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
ReDim Preserve handler.basis(j - 1)
|
|
||||||
'---baseline-----------------------------------------------------------------
|
|
||||||
ReDim handler.baseline(100)
|
|
||||||
i = 2
|
|
||||||
j = 0
|
|
||||||
Do While Sheets("config").Cells(3, i) <> ""
|
|
||||||
handler.baseline(j) = Sheets("config").Cells(3, i)
|
|
||||||
j = j + 1
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
ReDim Preserve handler.baseline(j - 1)
|
|
||||||
'---adjustments-----------------------------------------------------------------
|
|
||||||
ReDim handler.adjust(100)
|
|
||||||
i = 2
|
|
||||||
j = 0
|
|
||||||
Do While Sheets("config").Cells(4, i) <> ""
|
|
||||||
handler.adjust(j) = Sheets("config").Cells(4, i)
|
|
||||||
j = j + 1
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
ReDim Preserve handler.adjust(j - 1)
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
|
||||||
|
|
||||||
Dim j As Object
|
|
||||||
Dim i As Integer
|
|
||||||
Dim r As Long
|
|
||||||
Dim sh As Worksheet
|
|
||||||
Set sh = Sheets("_month")
|
|
||||||
|
|
||||||
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
|
||||||
sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
|
|
||||||
|
|
||||||
For i = 0 To 12
|
|
||||||
'------------volume-------------------
|
|
||||||
sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
|
|
||||||
sh.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
|
|
||||||
sh.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
|
|
||||||
sh.Cells(i + 1, 4) = 0
|
|
||||||
sh.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
|
|
||||||
|
|
||||||
'------------value----------------------
|
|
||||||
sh.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
|
|
||||||
sh.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
|
|
||||||
sh.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
|
|
||||||
sh.Cells(i + 1, 14) = 0
|
|
||||||
sh.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
|
|
||||||
|
|
||||||
'-------------price----------------------
|
|
||||||
If i > 0 Then
|
|
||||||
'--prior--
|
|
||||||
If co_num(pkg(i, 1), 0) = 0 Then
|
|
||||||
sh.Cells(i + 1, 6) = 0
|
|
||||||
Else
|
|
||||||
sh.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
|
|
||||||
End If
|
|
||||||
|
|
||||||
'--base--
|
|
||||||
If co_num(pkg(i, 2), 0) = 0 Then
|
|
||||||
'if there is no monthly base volume,
|
|
||||||
'then use the prior price, if there was no prior price,
|
|
||||||
'then inherit the average price for the year before current adjustments
|
|
||||||
If sh.Cells(i, 7) <> 0 Then
|
|
||||||
sh.Cells(i + 1, 7) = sh.Cells(i, 7)
|
|
||||||
Else
|
|
||||||
If pkg(13, 1) + pkg(13, 2) = 0 Then
|
|
||||||
sh.Cells(i + 1, 7) = 0
|
|
||||||
Else
|
|
||||||
sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
|
|
||||||
End If
|
|
||||||
|
|
||||||
'--adjust--
|
|
||||||
If (pkg(i, 3) + pkg(i, 2)) = 0 Or pkg(i, 2) = 0 Then
|
|
||||||
sh.Cells(i + 1, 8) = 0
|
|
||||||
Else
|
|
||||||
sh.Cells(i + 1, 8) = (pkg(i, 7) + pkg(i, 6)) / (pkg(i, 3) + pkg(i, 2)) - (pkg(i, 6) / pkg(i, 2))
|
|
||||||
End If
|
|
||||||
|
|
||||||
'--current adjust--
|
|
||||||
sh.Cells(i + 1, 9) = 0
|
|
||||||
|
|
||||||
'--forecast--
|
|
||||||
If co_num(pkg(i, 4), 0) = 0 Then
|
|
||||||
'if there is no monthly base volume,
|
|
||||||
'then use the prior price, if there was no prior price,
|
|
||||||
'then inherit the average price for the year before current adjustments
|
|
||||||
If sh.Cells(i, 10) <> 0 Then
|
|
||||||
sh.Cells(i + 1, 10) = sh.Cells(i, 10)
|
|
||||||
Else
|
|
||||||
If pkg(13, 1) + pkg(13, 2) = 0 Then
|
|
||||||
sh.Cells(i + 1, 10) = 0
|
|
||||||
Else
|
|
||||||
sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
|
|
||||||
End If
|
|
||||||
|
|
||||||
End If
|
|
||||||
|
|
||||||
Next i
|
|
||||||
|
|
||||||
'scenario
|
|
||||||
Sheets("_month").Range("R1:S1000").ClearContents
|
|
||||||
For i = 0 To UBound(handler.sc, 1)
|
|
||||||
sh.Cells(i + 1, 18) = handler.sc(i, 0)
|
|
||||||
sh.Cells(i + 1, 19) = handler.sc(i, 1)
|
|
||||||
Next i
|
|
||||||
|
|
||||||
'basket
|
|
||||||
sh.Range("U1:AC100000").ClearContents
|
|
||||||
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
|
|
||||||
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
|
|
||||||
Sheets("config").Cells(5, 2) = 0
|
|
||||||
Sheets("config").Cells(6, 2) = 0
|
|
||||||
Sheets("config").Cells(7, 2) = 0
|
|
||||||
|
|
||||||
months.load_sheet
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
|
|
||||||
|
|
||||||
If one = "" Or IsNull(one) Then
|
|
||||||
co_num = two
|
|
||||||
Else
|
|
||||||
co_num = one
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
|
|
||||||
Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
|
|
||||||
|
|
||||||
Dim req As New WinHttp.WinHttpRequest
|
|
||||||
Dim json As Object
|
|
||||||
Dim wr As String
|
|
||||||
Dim i As Integer
|
|
||||||
Dim j As Integer
|
|
||||||
Dim res() As Variant
|
|
||||||
|
|
||||||
If doc = "" Then
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
server = Sheets("config").Cells(1, 2)
|
|
||||||
|
|
||||||
With req
|
|
||||||
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
|
||||||
.Open "GET", server & "/list_changes", True
|
|
||||||
.SetRequestHeader "Content-Type", "application/json"
|
|
||||||
.Send doc
|
|
||||||
.WaitForResponse
|
|
||||||
wr = .ResponseText
|
|
||||||
End With
|
|
||||||
|
|
||||||
Set json = JsonConverter.ParseJson(wr)
|
|
||||||
|
|
||||||
If IsNull(json("x")) Then
|
|
||||||
MsgBox ("no history")
|
|
||||||
fail = True
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
ReDim res(json("x").Count - 1, 5)
|
|
||||||
|
|
||||||
For i = 0 To UBound(res, 1)
|
|
||||||
res(i, 0) = json("x")(i + 1)("user")
|
|
||||||
res(i, 1) = json("x")(i + 1)("stamp")
|
|
||||||
res(i, 2) = json("x")(i + 1)("comment")
|
|
||||||
res(i, 3) = json("x")(i + 1)("sales")
|
|
||||||
res(i, 4) = json("x")(i + 1)("def")
|
|
||||||
Next i
|
|
||||||
|
|
||||||
list_changes = res
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Sub history()
|
|
||||||
|
|
||||||
changes.Show
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
35
login.frm
35
login.frm
@ -1,35 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} login
|
|
||||||
Caption = "CMS Login"
|
|
||||||
ClientHeight = 2295
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 2445
|
|
||||||
OleObjectBlob = "login.frx":0000
|
|
||||||
StartUpPosition = 1 'CenterOwner
|
|
||||||
End
|
|
||||||
Attribute VB_Name = "login"
|
|
||||||
Attribute VB_GlobalNameSpace = False
|
|
||||||
Attribute VB_Creatable = False
|
|
||||||
Attribute VB_PredeclaredId = True
|
|
||||||
Attribute VB_Exposed = False
|
|
||||||
Public proceed As Boolean
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub cbCANCEL_Click()
|
|
||||||
tbU.Text = ""
|
|
||||||
tbP.Text = ""
|
|
||||||
proceed = False
|
|
||||||
Me.Hide
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub cbOK_Click()
|
|
||||||
proceed = True
|
|
||||||
Me.Hide
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub UserForm_Terminate()
|
|
||||||
proceed = False
|
|
||||||
End Sub
|
|
||||||
963
months.cls
963
months.cls
@ -1,963 +0,0 @@
|
|||||||
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 rollback As Boolean
|
|
||||||
Private scenario() As Variant
|
|
||||||
Private orig As Range
|
|
||||||
Private basket_touch As Range
|
|
||||||
Private showbasket As Boolean
|
|
||||||
Private np As Object 'json dedicated to new part scenario
|
|
||||||
Private b() As Variant 'holds basket
|
|
||||||
|
|
||||||
Private Sub Worksheet_Change(ByVal target As Range)
|
|
||||||
|
|
||||||
If Not dumping Then
|
|
||||||
|
|
||||||
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 Worksheets("config").Cells(6, 2) = 1 Then
|
|
||||||
Set basket_touch = target
|
|
||||||
Call Me.get_edit_basket
|
|
||||||
Set basket_touch = Nothing
|
|
||||||
End If
|
|
||||||
|
|
||||||
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 Worksheets("config").Cells(6, 2) = 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 Worksheets("config").Cells(6, 2) = 1 Then
|
|
||||||
Call Me.basket_pick(Selection)
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, cancel As Boolean)
|
|
||||||
|
|
||||||
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
|
||||||
cancel = True
|
|
||||||
Call Me.basket_pick(target)
|
|
||||||
target.Select
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Public Function rev_cust(cust As String) As String
|
|
||||||
|
|
||||||
If cust = "" Then
|
|
||||||
rev_cust = ""
|
|
||||||
Exit Function
|
|
||||||
End If
|
|
||||||
|
|
||||||
If InStr(1, cust, " - ") <= 9 Then
|
|
||||||
rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(left(cust, 8))
|
|
||||||
Else
|
|
||||||
rev_cust = trim(right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - "))
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
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)
|
|
||||||
If units(i, 4) = 0 And price(i, 4) = 0 Then
|
|
||||||
sales(i, 4) = 0
|
|
||||||
Else
|
|
||||||
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Me.crunch_array
|
|
||||||
Me.build_json
|
|
||||||
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)
|
|
||||||
If units(i, 4) = 0 And price(i, 4) = 0 Then
|
|
||||||
sales(i, 4) = 0
|
|
||||||
Else
|
|
||||||
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Me.crunch_array
|
|
||||||
Me.build_json
|
|
||||||
Me.set_sheet
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub ms_set()
|
|
||||||
|
|
||||||
On Error GoTo errh
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
Call Me.get_sheet
|
|
||||||
Dim vp As String
|
|
||||||
vp = Sheets("month").Range("Q2")
|
|
||||||
|
|
||||||
For i = 1 To 12
|
|
||||||
If sales(i, 5) = "" Then sales(i, 5) = 0
|
|
||||||
If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 2) <> Round(sales(i, 4), 2) Then
|
|
||||||
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
|
||||||
Select Case vp
|
|
||||||
Case "volume"
|
|
||||||
If co_num(price(i, 5), 0) = 0 Then
|
|
||||||
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
|
|
||||||
dumping = True
|
|
||||||
Application.Undo
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
'reset price to original - delete these lines if a cascading effect is desired
|
|
||||||
'price(i, 4) = 0
|
|
||||||
'price(i, 5) = price(i, 2) + price(i, 3)
|
|
||||||
'calc volume change on original price
|
|
||||||
units(i, 5) = sales(i, 5) / price(i, 5)
|
|
||||||
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
|
||||||
Case "price"
|
|
||||||
If co_num(units(i, 5), 0) = 0 Then
|
|
||||||
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
|
|
||||||
dumping = True
|
|
||||||
Application.Undo
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
price(i, 5) = sales(i, 5) / units(i, 5)
|
|
||||||
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
|
||||||
Case Else
|
|
||||||
MsgBox ("error forcing sales with no offset specified - your change will be undone")
|
|
||||||
dumping = True
|
|
||||||
Application.Undo
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End Select
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Me.crunch_array
|
|
||||||
Me.build_json
|
|
||||||
Me.set_sheet
|
|
||||||
|
|
||||||
errh:
|
|
||||||
If Err.Number <> 0 Then rollback = True
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub ms_adj()
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
Call Me.get_sheet
|
|
||||||
Dim vp As String
|
|
||||||
vp = Sheets("month").Range("Q2")
|
|
||||||
|
|
||||||
For i = 1 To 12
|
|
||||||
If sales(i, 4) = "" Then sales(i, 4) = 0
|
|
||||||
If Round(sales(i, 5), 6) <> Round(sales(i, 2) + sales(i, 3) + sales(i, 4), 6) Then
|
|
||||||
sales(i, 5) = sales(i, 4) + sales(i, 2) + sales(i, 3)
|
|
||||||
Select Case vp
|
|
||||||
Case "volume"
|
|
||||||
If co_num(price(i, 5), 0) = 0 Then
|
|
||||||
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
|
|
||||||
dumping = True
|
|
||||||
Application.Undo
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
'reset price to original
|
|
||||||
'price(i, 4) = 0
|
|
||||||
'price(i, 5) = price(i, 2) + price(i, 3)
|
|
||||||
'calc volume change on original price
|
|
||||||
units(i, 5) = sales(i, 5) / price(i, 5)
|
|
||||||
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
|
||||||
Case "price"
|
|
||||||
If co_num(units(i, 5), 0) = 0 Then
|
|
||||||
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
|
|
||||||
dumping = True
|
|
||||||
Application.Undo
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
price(i, 5) = sales(i, 5) / units(i, 5)
|
|
||||||
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
|
||||||
Case Else
|
|
||||||
MsgBox ("error forcing sales with no offset specified - your change will be undone")
|
|
||||||
dumping = True
|
|
||||||
Application.Undo
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End Select
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Me.crunch_array
|
|
||||||
Me.build_json
|
|
||||||
Me.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(Sheets("_month").Range("P1").FormulaR1C1)
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
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
|
|
||||||
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
|
||||||
'Sheets("month").Range("B32:Q5000").ClearContents
|
|
||||||
|
|
||||||
If Me.newpart Then
|
|
||||||
Sheets("_month").Range("P2:P13").ClearContents
|
|
||||||
Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
|
|
||||||
Else
|
|
||||||
For i = 1 To 12
|
|
||||||
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
|
||||||
Next i
|
|
||||||
End If
|
|
||||||
|
|
||||||
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
|
|
||||||
scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
|
|
||||||
tunits = Range("B18:F18")
|
|
||||||
tprice = Range("H18:L18")
|
|
||||||
tsales = Range("N18:R18")
|
|
||||||
'reset basket
|
|
||||||
Sheets("_month").Range("U1:X10000").ClearContents
|
|
||||||
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
|
|
||||||
ReDim adjust(12)
|
|
||||||
Call Me.crunch_array
|
|
||||||
Call Me.set_sheet
|
|
||||||
Call Me.print_basket
|
|
||||||
Call Me.set_format
|
|
||||||
|
|
||||||
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_grey(ByRef target As Range)
|
|
||||||
|
|
||||||
|
|
||||||
With target.Interior
|
|
||||||
.Pattern = xlSolid
|
|
||||||
.PatternColorIndex = xlAutomatic
|
|
||||||
.ThemeColor = xlThemeColorDark1
|
|
||||||
.TintAndShade = -0.149998474074526
|
|
||||||
.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()
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
Dim j As Long
|
|
||||||
Dim pos As Long
|
|
||||||
Dim o As Object
|
|
||||||
Dim m As Object
|
|
||||||
Dim list As Object
|
|
||||||
|
|
||||||
ReDim handler.basis(100)
|
|
||||||
i = 2
|
|
||||||
j = 0
|
|
||||||
Do While Sheets("config").Cells(2, i) <> ""
|
|
||||||
handler.basis(j) = Sheets("config").Cells(2, i)
|
|
||||||
j = j + 1
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
ReDim Preserve handler.basis(j - 1)
|
|
||||||
|
|
||||||
ReDim adjust(12)
|
|
||||||
|
|
||||||
If Me.newpart Then
|
|
||||||
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") = "b20"
|
|
||||||
Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
|
|
||||||
np("source") = "adj"
|
|
||||||
np("type") = "new_basket"
|
|
||||||
Set m = JsonConverter.ParseJson("{}")
|
|
||||||
End If
|
|
||||||
|
|
||||||
For pos = 1 To 12
|
|
||||||
If Me.newpart Then
|
|
||||||
If sales(pos, 5) <> 0 Then
|
|
||||||
Set o = JsonConverter.ParseJson("{}")
|
|
||||||
o("amount") = sales(pos, 5)
|
|
||||||
o("qty") = units(pos, 5)
|
|
||||||
Set m(Worksheets("month").Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
|
|
||||||
End If
|
|
||||||
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))
|
|
||||||
'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
|
|
||||||
If Round(price(pos, 5), 8) <> Round(tprice(1, 2) + tprice(1, 3), 8) Then
|
|
||||||
'if the target price is diferent from the average and a month is being added
|
|
||||||
adjust(pos)("type") = "addmonth_vp"
|
|
||||||
Else
|
|
||||||
'if the target price is the same as average and a month is being added
|
|
||||||
adjust(pos)("type") = "addmonth_v"
|
|
||||||
End If
|
|
||||||
adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1)
|
|
||||||
adjust(pos)("qty") = units(pos, 4)
|
|
||||||
adjust(pos)("amount") = sales(pos, 4)
|
|
||||||
Else
|
|
||||||
'scale the existing volume(price) on the target month
|
|
||||||
If Round(price(pos, 4), 8) <> 0 Then
|
|
||||||
If Round(units(pos, 4), 2) <> 0 Then
|
|
||||||
adjust(pos)("type") = "scale_vp"
|
|
||||||
Else
|
|
||||||
adjust(pos)("type") = "scale_p"
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
'if the target price is the same as average and a month is being added
|
|
||||||
adjust(pos)("type") = "scale_v"
|
|
||||||
End If
|
|
||||||
adjust(pos)("qty") = units(pos, 4)
|
|
||||||
adjust(pos)("amount") = sales(pos, 4)
|
|
||||||
'------------add this in to only scale a particular month--------------------
|
|
||||||
adjust(pos)("scenario")("order_month") = Worksheets("month").Cells(5 + pos, 1)
|
|
||||||
End If
|
|
||||||
adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
|
|
||||||
adjust(pos)("user") = Application.UserName
|
|
||||||
adjust(pos)("scenario")("version") = "b20"
|
|
||||||
adjust(pos)("scenario")("iter") = handler.basis
|
|
||||||
adjust(pos)("source") = "adj"
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Next pos
|
|
||||||
|
|
||||||
If Me.newpart Then
|
|
||||||
Set np("months") = JsonConverter.ParseJson(JsonConverter.ConvertToJson(m))
|
|
||||||
np("newpart") = Worksheets("month").Range("B33").value
|
|
||||||
'np("basket") = x.json_from_table(b, "basket", False)
|
|
||||||
'get the basket from the sheet
|
|
||||||
b = Worksheets("_month").Range("U1").CurrentRegion.value
|
|
||||||
Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
|
|
||||||
If UBound(b, 1) <= 2 Then
|
|
||||||
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
|
|
||||||
Else
|
|
||||||
Set np("basket") = m("basket")
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
If Me.newpart Then
|
|
||||||
Sheets("_month").Range("P2:P13").ClearContents
|
|
||||||
Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
|
|
||||||
Else
|
|
||||||
For i = 1 To 12
|
|
||||||
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
|
||||||
Next i
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub crunch_array()
|
|
||||||
|
|
||||||
Dim i As Integer
|
|
||||||
Dim j 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
|
|
||||||
For j = 1 To 5
|
|
||||||
tunits(1, j) = tunits(1, j) + units(i, j)
|
|
||||||
tsales(1, j) = tsales(1, j) + sales(i, j)
|
|
||||||
Next j
|
|
||||||
Next i
|
|
||||||
|
|
||||||
'prior
|
|
||||||
If tunits(1, 1) = 0 Then
|
|
||||||
tprice(1, 1) = 0
|
|
||||||
Else
|
|
||||||
tprice(1, 1) = tsales(1, 1) / tunits(1, 1)
|
|
||||||
End If
|
|
||||||
'base
|
|
||||||
If tunits(1, 2) = 0 Then
|
|
||||||
tprice(1, 2) = 0
|
|
||||||
Else
|
|
||||||
tprice(1, 2) = tsales(1, 2) / tunits(1, 2)
|
|
||||||
End If
|
|
||||||
'forecast
|
|
||||||
If tunits(1, 5) <> 0 Then
|
|
||||||
tprice(1, 5) = tsales(1, 5) / tunits(1, 5)
|
|
||||||
Else
|
|
||||||
tprice(1, 5) = 0
|
|
||||||
End If
|
|
||||||
'adjust
|
|
||||||
If (tunits(1, 2) + tunits(1, 3)) = 0 Then
|
|
||||||
tprice(1, 3) = 0
|
|
||||||
Else
|
|
||||||
tprice(1, 3) = (tsales(1, 2) + tsales(1, 3)) / (tunits(1, 2) + tunits(1, 3)) - tprice(1, 2)
|
|
||||||
End If
|
|
||||||
'current adjust
|
|
||||||
tprice(1, 4) = tprice(1, 5) - (tprice(1, 2) + tprice(1, 3))
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub cancel()
|
|
||||||
|
|
||||||
Sheets("Orders").Select
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub reset()
|
|
||||||
|
|
||||||
|
|
||||||
Call Me.load_sheet
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub switch_basket()
|
|
||||||
|
|
||||||
|
|
||||||
If Sheets("config").Cells(6, 2) = 1 Then
|
|
||||||
Sheets("config").Cells(6, 2) = 0
|
|
||||||
Else
|
|
||||||
Sheets("config").Cells(6, 2) = 1
|
|
||||||
End If
|
|
||||||
|
|
||||||
Call Me.print_basket
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub print_basket()
|
|
||||||
|
|
||||||
'Sheets("config").Cells(6, 2) = 1
|
|
||||||
If Sheets("config").Cells(6, 2) = 0 Then
|
|
||||||
dumping = True
|
|
||||||
Worksheets("month").Range("B32:Q10000").ClearContents
|
|
||||||
Rows("20:31").Hidden = False
|
|
||||||
dumping = False
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
Dim basket() As Variant
|
|
||||||
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
|
|
||||||
|
|
||||||
dumping = True
|
|
||||||
|
|
||||||
Worksheets("month").Range("B32:Q10000").ClearContents
|
|
||||||
For i = 1 To UBound(basket, 1)
|
|
||||||
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
|
|
||||||
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
|
|
||||||
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
|
|
||||||
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Rows("20:31").Hidden = True
|
|
||||||
|
|
||||||
dumping = False
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Sub basket_pick(ByRef target As Range)
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
|
|
||||||
|
|
||||||
build.part = Sheets("month").Cells(target.row, 2)
|
|
||||||
build.bill = rev_cust(Sheets("month").Cells(target.row, 6))
|
|
||||||
build.ship = rev_cust(Sheets("month").Cells(target.row, 12))
|
|
||||||
build.useval = False
|
|
||||||
build.Show
|
|
||||||
|
|
||||||
If build.useval Then
|
|
||||||
dumping = True
|
|
||||||
'if an empty row is selected, force it to be the next open slot
|
|
||||||
If Sheets("month").Cells(target.row, 2) = "" Then
|
|
||||||
Do Until Sheets("month").Cells(target.row + i, 2) <> ""
|
|
||||||
i = i - 1
|
|
||||||
Loop
|
|
||||||
i = i + 1
|
|
||||||
End If
|
|
||||||
|
|
||||||
|
|
||||||
Sheets("month").Cells(target.row + i, 2) = build.cbPart.value
|
|
||||||
Sheets("month").Cells(target.row + i, 6) = rev_cust(build.cbBill.value)
|
|
||||||
Sheets("month").Cells(target.row + i, 12) = rev_cust(build.cbShip.value)
|
|
||||||
dumping = False
|
|
||||||
Set basket_touch = Selection
|
|
||||||
Call Me.get_edit_basket
|
|
||||||
Set basket_touch = Nothing
|
|
||||||
|
|
||||||
End If
|
|
||||||
target.Select
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub get_edit_basket()
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
Dim mix As Double
|
|
||||||
Dim touch_mix As Double
|
|
||||||
Dim untouched As Long
|
|
||||||
Dim touch() As Boolean
|
|
||||||
|
|
||||||
'ReDim b(basket_rows, 3)
|
|
||||||
|
|
||||||
i = 0
|
|
||||||
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
i = i - 1
|
|
||||||
|
|
||||||
ReDim b(i, 3)
|
|
||||||
ReDim touch(i)
|
|
||||||
untouched = i + 1
|
|
||||||
|
|
||||||
i = 0
|
|
||||||
mix = 0
|
|
||||||
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
|
||||||
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
|
|
||||||
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
|
|
||||||
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
|
|
||||||
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
|
|
||||||
If b(i, 3) = "" Then b(i, 3) = 0
|
|
||||||
mix = mix + b(i, 3)
|
|
||||||
If Not Intersect(basket_touch, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then
|
|
||||||
touch_mix = touch_mix + b(i, 3)
|
|
||||||
touch(i) = True
|
|
||||||
untouched = untouched - 1
|
|
||||||
End If
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
|
|
||||||
'evaluate mix changes and force to 100
|
|
||||||
For i = 0 To UBound(b, 1)
|
|
||||||
If Not touch(i) Then
|
|
||||||
If mix - touch_mix = 0 Then
|
|
||||||
b(i, 3) = (1 - mix) / untouched
|
|
||||||
Else
|
|
||||||
b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix)
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
dumping = True
|
|
||||||
|
|
||||||
'put the mix plug back on the the sheet
|
|
||||||
For i = 0 To UBound(b, 1)
|
|
||||||
Worksheets("month").Cells(33 + i, 17) = b(i, 3)
|
|
||||||
Next i
|
|
||||||
|
|
||||||
dumping = False
|
|
||||||
|
|
||||||
Worksheets("_month").Range("U2:X5000").ClearContents
|
|
||||||
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
|
||||||
|
|
||||||
If Me.newpart Then
|
|
||||||
Me.build_json
|
|
||||||
End If
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Sub post_adjust()
|
|
||||||
|
|
||||||
Dim i As Long
|
|
||||||
Dim fail As Boolean
|
|
||||||
|
|
||||||
If Me.newpart Then
|
|
||||||
Call handler.request_adjust(Sheets("_month").Cells(2, 16), fail)
|
|
||||||
If fail Then Exit Sub
|
|
||||||
Else
|
|
||||||
For i = 2 To 13
|
|
||||||
If Sheets("_month").Cells(i, 16) <> "" Then
|
|
||||||
Call handler.request_adjust(Sheets("_month").Cells(i, 16), fail)
|
|
||||||
If fail Then Exit Sub
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
End If
|
|
||||||
|
|
||||||
Sheets("Orders").Select
|
|
||||||
'Worksheets("month").Visible = xlHidden
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub build_new()
|
|
||||||
|
|
||||||
Worksheets("config").Cells(5, 2) = 1
|
|
||||||
Dim i As Long
|
|
||||||
Dim j As Long
|
|
||||||
Dim basket() As Variant
|
|
||||||
Dim m() As Variant
|
|
||||||
|
|
||||||
dumping = True
|
|
||||||
|
|
||||||
m = Sheets("_month").Range("A2:O13").FormulaR1C1
|
|
||||||
|
|
||||||
For i = 1 To UBound(m, 1)
|
|
||||||
For j = 1 To UBound(m, 2)
|
|
||||||
m(i, j) = 0
|
|
||||||
Next j
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Worksheets("_month").Range("A2:O13") = m
|
|
||||||
|
|
||||||
Worksheets("_month").Range("U2:X1000").ClearContents
|
|
||||||
Worksheets("_month").Range("Z2:AC1000").ClearContents
|
|
||||||
Worksheets("_month").Range("R2:S1000").ClearContents
|
|
||||||
Call Me.load_sheet
|
|
||||||
'Call Me.set_sheet
|
|
||||||
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
|
||||||
|
|
||||||
basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
|
|
||||||
Sheets("month").Cells(32, 2) = basket(1, 1)
|
|
||||||
Sheets("month").Cells(32, 6) = basket(1, 2)
|
|
||||||
Sheets("month").Cells(32, 12) = basket(1, 3)
|
|
||||||
Sheets("month").Cells(32, 17) = basket(1, 4)
|
|
||||||
Call Me.print_basket
|
|
||||||
|
|
||||||
dumping = False
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Sub new_part()
|
|
||||||
|
|
||||||
'keep customer mix
|
|
||||||
'add in new part number
|
|
||||||
'retain to _month
|
|
||||||
'set new part flag
|
|
||||||
|
|
||||||
Dim cust() As String
|
|
||||||
Dim i As Long
|
|
||||||
|
|
||||||
'---------build customer mix-------------------------------------------------------------------
|
|
||||||
|
|
||||||
cust = x.SHTp_Get("_month", 1, 27, True)
|
|
||||||
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
|
|
||||||
MsgBox ("error building customer mix")
|
|
||||||
End If
|
|
||||||
|
|
||||||
'--------inquire for new part to join with cust mix--------------------------------------------
|
|
||||||
|
|
||||||
part.Show
|
|
||||||
|
|
||||||
If Not part.useval Then
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
dumping = True
|
|
||||||
|
|
||||||
Worksheets("month").Range("B33:Q10000").ClearContents
|
|
||||||
|
|
||||||
For i = 1 To UBound(cust, 2)
|
|
||||||
Sheets("month").Cells(32 + i, 2) = part.cbPart.value
|
|
||||||
Sheets("month").Cells(32 + i, 6) = cust(0, i)
|
|
||||||
Sheets("month").Cells(32 + i, 12) = cust(1, i)
|
|
||||||
Sheets("month").Cells(32 + i, 17) = CDbl(cust(2, i))
|
|
||||||
Next i
|
|
||||||
|
|
||||||
Sheets("config").Cells(7, 2) = 1
|
|
||||||
|
|
||||||
'------copy revised basket to _month storage---------------------------------------------------
|
|
||||||
|
|
||||||
i = 0
|
|
||||||
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
i = i - 1
|
|
||||||
If i = -1 Then i = 0
|
|
||||||
ReDim b(i, 3)
|
|
||||||
i = 0
|
|
||||||
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
|
||||||
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
|
|
||||||
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
|
|
||||||
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
|
|
||||||
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
|
|
||||||
If b(i, 3) = "" Then b(i, 3) = 0
|
|
||||||
i = i + 1
|
|
||||||
Loop
|
|
||||||
Worksheets("_month").Range("U2:AC10000").ClearContents
|
|
||||||
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
|
||||||
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
|
|
||||||
|
|
||||||
'------reset volume to copy base to forecsat and clear base------------------------------------
|
|
||||||
|
|
||||||
units = Sheets("_month").Range("A2:E13").FormulaR1C1
|
|
||||||
price = Sheets("_month").Range("F2:J13").FormulaR1C1
|
|
||||||
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
|
|
||||||
tunits = Range("B18:F18")
|
|
||||||
tprice = Range("H18:L18")
|
|
||||||
tsales = Range("N18:R18")
|
|
||||||
ReDim adjust(12)
|
|
||||||
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
|
|
||||||
For i = 1 To 12
|
|
||||||
'volume
|
|
||||||
units(i, 5) = units(i, 2)
|
|
||||||
units(i, 4) = units(i, 2)
|
|
||||||
units(i, 1) = 0
|
|
||||||
units(i, 2) = 0
|
|
||||||
units(i, 3) = 0
|
|
||||||
'sales
|
|
||||||
sales(i, 5) = sales(i, 2)
|
|
||||||
sales(i, 4) = sales(i, 2)
|
|
||||||
sales(i, 1) = 0
|
|
||||||
sales(i, 2) = 0
|
|
||||||
sales(i, 3) = 0
|
|
||||||
'price
|
|
||||||
price(i, 5) = price(i, 2)
|
|
||||||
price(i, 4) = price(i, 2)
|
|
||||||
price(i, 1) = 0
|
|
||||||
price(i, 2) = 0
|
|
||||||
price(i, 3) = 0
|
|
||||||
Next i
|
|
||||||
Call Me.crunch_array
|
|
||||||
Call Me.build_json
|
|
||||||
Call Me.set_sheet
|
|
||||||
|
|
||||||
'-------------push revised arrays back to _month, not revertable-------------------------------
|
|
||||||
|
|
||||||
Worksheets("_month").Range("A2:E13") = units
|
|
||||||
Worksheets("_month").Range("F2:J13") = price
|
|
||||||
Worksheets("_month").Range("K2:o13") = sales
|
|
||||||
|
|
||||||
|
|
||||||
'force basket to show to demonstrate the part was changed
|
|
||||||
Sheets("config").Cells(6, 2) = 1
|
|
||||||
Call Me.print_basket
|
|
||||||
dumping = False
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Function newpart() As Boolean
|
|
||||||
|
|
||||||
If Worksheets("config").Cells(7, 2) = 1 Then
|
|
||||||
newpart = True
|
|
||||||
Else
|
|
||||||
newpart = False
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
|
|
||||||
51
openf.frm
51
openf.frm
@ -1,51 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
|
|
||||||
Caption = "Open a Forecast"
|
|
||||||
ClientHeight = 2025
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 3825
|
|
||||||
OleObjectBlob = "openf.frx":0000
|
|
||||||
StartUpPosition = 1 'CenterOwner
|
|
||||||
End
|
|
||||||
Attribute VB_Name = "openf"
|
|
||||||
Attribute VB_GlobalNameSpace = False
|
|
||||||
Attribute VB_Creatable = False
|
|
||||||
Attribute VB_PredeclaredId = True
|
|
||||||
Attribute VB_Exposed = False
|
|
||||||
Private Sub cbCancel_Click()
|
|
||||||
|
|
||||||
openf.Hide
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub cbOK_Click()
|
|
||||||
|
|
||||||
Application.StatusBar = "Retrieving data for " & cbDSM.value & "....."
|
|
||||||
|
|
||||||
openf.Caption = "retrieving data......"
|
|
||||||
Call handler.pg_main_workset(cbDSM.value)
|
|
||||||
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
|
|
||||||
Application.StatusBar = False
|
|
||||||
openf.Hide
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub UserForm_Activate()
|
|
||||||
|
|
||||||
'handler.server = "http://192.168.1.69:3000"
|
|
||||||
handler.server = Sheets("config").Cells(1, 2)
|
|
||||||
|
|
||||||
Dim x As New TheBigOne
|
|
||||||
Dim d() As String
|
|
||||||
|
|
||||||
openf.Caption = "Select a DSM"
|
|
||||||
d = x.SHTp_Get("reps", 1, 1, True)
|
|
||||||
|
|
||||||
For i = 1 To UBound(d, 2)
|
|
||||||
Call cbDSM.AddItem(d(0, i))
|
|
||||||
Next i
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
48
part.frm
48
part.frm
@ -1,48 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part
|
|
||||||
Caption = "Part Picker"
|
|
||||||
ClientHeight = 1080
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 8100
|
|
||||||
OleObjectBlob = "part.frx":0000
|
|
||||||
StartUpPosition = 1 'CenterOwner
|
|
||||||
End
|
|
||||||
Attribute VB_Name = "part"
|
|
||||||
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 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
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub UserForm_Activate()
|
|
||||||
|
|
||||||
useval = False
|
|
||||||
|
|
||||||
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
107
pivot.bas
107
pivot.bas
@ -1,107 +0,0 @@
|
|||||||
VERSION 1.0 CLASS
|
|
||||||
BEGIN
|
|
||||||
MultiUse = -1 'True
|
|
||||||
END
|
|
||||||
Attribute VB_Name = "pivot"
|
|
||||||
Attribute VB_GlobalNameSpace = False
|
|
||||||
Attribute VB_Creatable = False
|
|
||||||
Attribute VB_PredeclaredId = True
|
|
||||||
Attribute VB_Exposed = True
|
|
||||||
Option Explicit
|
|
||||||
|
|
||||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
|
||||||
|
|
||||||
If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
On Error GoTo nopiv
|
|
||||||
|
|
||||||
If Target.Cells.PivotTable Is Nothing Then
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
Cancel = True
|
|
||||||
|
|
||||||
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 pt As PivotTable
|
|
||||||
Dim pf As PivotField
|
|
||||||
Dim pi As PivotItem
|
|
||||||
Dim wapi As New Windows_API
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
|
|
||||||
ReDim handler.sc(ri.Count, 1)
|
|
||||||
Set pt = Target.Cells.PivotCell.PivotTable
|
|
||||||
|
|
||||||
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 & " = '" & ri(i).Name & "'"
|
|
||||||
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & 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 & "}"
|
|
||||||
|
|
||||||
Call handler.load_config
|
|
||||||
Call handler.load_fpvt
|
|
||||||
|
|
||||||
|
|
||||||
nopiv:
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Function piv_pos(list As Object, target_pos As Long) 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
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) 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
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
113
pivot.cls
113
pivot.cls
@ -1,113 +0,0 @@
|
|||||||
VERSION 1.0 CLASS
|
|
||||||
BEGIN
|
|
||||||
MultiUse = -1 'True
|
|
||||||
END
|
|
||||||
Attribute VB_Name = "pivot"
|
|
||||||
Attribute VB_GlobalNameSpace = False
|
|
||||||
Attribute VB_Creatable = False
|
|
||||||
Attribute VB_PredeclaredId = True
|
|
||||||
Attribute VB_Exposed = True
|
|
||||||
Option Explicit
|
|
||||||
|
|
||||||
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
|
|
||||||
|
|
||||||
If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
On Error GoTo nopiv
|
|
||||||
|
|
||||||
If target.Cells.PivotTable Is Nothing Then
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
cancel = True
|
|
||||||
|
|
||||||
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 pt As PivotTable
|
|
||||||
Dim pf As PivotField
|
|
||||||
Dim pi As PivotItem
|
|
||||||
Dim wapi As New Windows_API
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
ReDim handler.sc(ri.Count, 1)
|
|
||||||
Set pt = target.Cells.PivotCell.PivotTable
|
|
||||||
|
|
||||||
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(ri(i).Name) & "'"
|
|
||||||
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape(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 & "}"
|
|
||||||
|
|
||||||
Call handler.load_config
|
|
||||||
Call handler.load_fpvt
|
|
||||||
|
|
||||||
nopiv:
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Function piv_pos(list As Object, target_pos As Long) 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
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) 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
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
Function escape(ByVal text As String) As String
|
|
||||||
|
|
||||||
text = Replace(text, "'", "''")
|
|
||||||
text = Replace(text, """", """""")
|
|
||||||
If text = "(blank)" Then text = ""
|
|
||||||
escape = text
|
|
||||||
|
|
||||||
End Function
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,48 +0,0 @@
|
|||||||
VERSION 5.00
|
|
||||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist
|
|
||||||
Caption = "Price List Name"
|
|
||||||
ClientHeight = 5115
|
|
||||||
ClientLeft = 120
|
|
||||||
ClientTop = 465
|
|
||||||
ClientWidth = 4110
|
|
||||||
OleObjectBlob = "pricelist.frx":0000
|
|
||||||
StartUpPosition = 1 'CenterOwner
|
|
||||||
End
|
|
||||||
Attribute VB_Name = "pricelist"
|
|
||||||
Attribute VB_GlobalNameSpace = False
|
|
||||||
Attribute VB_Creatable = False
|
|
||||||
Attribute VB_PredeclaredId = True
|
|
||||||
Attribute VB_Exposed = False
|
|
||||||
Public proceed As Boolean
|
|
||||||
|
|
||||||
Private Sub bCANCEL_Click()
|
|
||||||
proceed = False
|
|
||||||
Me.Hide
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub bOK_Click()
|
|
||||||
proceed = True
|
|
||||||
Me.Hide
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub bPICK_Click()
|
|
||||||
|
|
||||||
'--------Open file-------------
|
|
||||||
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
|
|
||||||
fd.Show
|
|
||||||
|
|
||||||
tbPATH.Text = fd.SelectedItems(1)
|
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub UserForm_Initialize()
|
|
||||||
proceed = False
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub UserForm_Terminate()
|
|
||||||
proceed = False
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
BIN
pricelist.frx
BIN
pricelist.frx
Binary file not shown.
Loading…
Reference in New Issue
Block a user