add a new route for swapping out parts
This commit is contained in:
parent
f569e6238d
commit
7e57d4621f
140
TheBigOne.cls
140
TheBigOne.cls
@ -459,6 +459,43 @@ Sub ARRAYp_Transpose(ByRef a() As String)
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Function ARRAYp_TransposeVar(ByRef a() As Variant) As Variant()
|
||||||
|
|
||||||
|
Dim s() As Variant
|
||||||
|
ReDim s(UBound(a, 2), UBound(a, 1))
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
|
||||||
|
For i = 0 To UBound(s, 1)
|
||||||
|
For j = 0 To UBound(s, 2)
|
||||||
|
s(i, j) = a(j, i)
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
|
||||||
|
ARRAYp_TransposeVar = s
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Function ARRAYp_zerobased_addheader(ByRef z() As Variant, ParamArray cols()) As Variant()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
|
||||||
|
Dim r() As Variant
|
||||||
|
ReDim r(UBound(z, 1), UBound(z, 2) + 1)
|
||||||
|
|
||||||
|
For i = 0 To UBound(r, 1)
|
||||||
|
For j = 1 To UBound(r, 2)
|
||||||
|
r(i, j) = z(i, j - 1)
|
||||||
|
Next j
|
||||||
|
r(i, 0) = cols(i)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
ARRAYp_zerobased_addheader = r
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
Public Function SHTp_Get(ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef headers As Boolean) As String()
|
Public Function SHTp_Get(ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef headers As Boolean) As String()
|
||||||
|
|
||||||
@ -1461,11 +1498,11 @@ End Function
|
|||||||
Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
|
Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
|
||||||
|
|
||||||
Application.EnableCancelKey = xlDisabled
|
Application.EnableCancelKey = xlDisabled
|
||||||
MsgB.tbMSG.Text = Message
|
MsgB.tbMSG.text = Message
|
||||||
MsgB.Caption = TITLE
|
MsgB.Caption = TITLE
|
||||||
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
|
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
|
||||||
MsgB.Show
|
MsgB.Show
|
||||||
MISC_msgbox_cancel = MsgB.cancel
|
MISC_msgbox_cancel = MsgB.Cancel
|
||||||
Application.EnableCancelKey = xlInterrupt
|
Application.EnableCancelKey = xlInterrupt
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
@ -2037,7 +2074,7 @@ Function json_concat(list As Range) As String
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
|
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
|
||||||
|
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
@ -2045,7 +2082,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, tri
|
|||||||
Dim sql As String
|
Dim sql As String
|
||||||
Dim rec As String
|
Dim rec As String
|
||||||
|
|
||||||
sql = "INSERT INTO " & target & " VALUES " & vbCrLf
|
sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
|
||||||
For i = start To ending
|
For i = start To ending
|
||||||
rec = ""
|
rec = ""
|
||||||
If i <> start Then sql = sql & "," & vbCrLf
|
If i <> start Then sql = sql & "," & vbCrLf
|
||||||
@ -2151,6 +2188,70 @@ Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As Str
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
Public Function json_from_table_zb(ByRef tbl() As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
|
||||||
|
|
||||||
|
|
||||||
|
Dim ajson As String
|
||||||
|
Dim json As String
|
||||||
|
Dim r As Integer
|
||||||
|
Dim c As Integer
|
||||||
|
Dim needs_comma As Boolean
|
||||||
|
Dim needs_braces As Integer
|
||||||
|
|
||||||
|
needs_comma = False
|
||||||
|
needs_braces = 0
|
||||||
|
ajson = ""
|
||||||
|
|
||||||
|
For r = 1 To UBound(tbl, 1)
|
||||||
|
For c = 0 To UBound(tbl, 2)
|
||||||
|
If tbl(r, c) <> "" Then
|
||||||
|
needs_braces = needs_braces + 1
|
||||||
|
If needs_comma Then json = json & ","
|
||||||
|
needs_comma = True
|
||||||
|
If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
|
||||||
|
json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & tbl(r, c)
|
||||||
|
Else
|
||||||
|
'test if item is a json object
|
||||||
|
If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
|
||||||
|
json = json & """" & tbl(0, c) & """" & ":" & tbl(r, c)
|
||||||
|
Else
|
||||||
|
json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Next c
|
||||||
|
If needs_braces > 0 Then json = "{" & json & "}"
|
||||||
|
needs_comma = False
|
||||||
|
needs_braces = 0
|
||||||
|
If r > 1 Then
|
||||||
|
ajson = ajson & "," & json
|
||||||
|
Else
|
||||||
|
ajson = json
|
||||||
|
End If
|
||||||
|
json = ""
|
||||||
|
Next r
|
||||||
|
|
||||||
|
'if theres more the one record, include brackets for array
|
||||||
|
'if an array_label is given give the array a key and the array become the value
|
||||||
|
'then if the array is labeled with a key it should have braces unless specified otherwise
|
||||||
|
If r > 2 Then
|
||||||
|
ajson = "[" & ajson & "]"
|
||||||
|
If array_label <> "" Then
|
||||||
|
ajson = """" & array_label & """:" & ajson
|
||||||
|
If Not strip_braces Then
|
||||||
|
ajson = "{" & ajson & "}"
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
If strip_braces Then
|
||||||
|
ajson = Mid(ajson, 2, Len(ajson) - 2)
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
json_from_table_zb = ajson
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
|
Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
|
||||||
|
|
||||||
If compare < base Then
|
If compare < base Then
|
||||||
@ -2444,7 +2545,7 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin
|
|||||||
Dim s As String, tmp As Double, i As Integer, lastI As Integer
|
Dim s As String, tmp As Double, i As Integer, lastI As Integer
|
||||||
Dim BaseSize As Integer
|
Dim BaseSize As Integer
|
||||||
BaseSize = Len(sNewBaseDigits)
|
BaseSize = Len(sNewBaseDigits)
|
||||||
Do While Val(d) <> 0
|
Do While val(d) <> 0
|
||||||
tmp = d
|
tmp = d
|
||||||
i = 0
|
i = 0
|
||||||
Do While tmp >= BaseSize
|
Do While tmp >= BaseSize
|
||||||
@ -2598,3 +2699,32 @@ Function TBLp_VarToString(ByRef t() As Variant) As String()
|
|||||||
TBLp_VarToString = x
|
TBLp_VarToString = x
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
|
||||||
|
hdr.ColumnCount = det.ColumnCount
|
||||||
|
hdr.ColumnWidths = det.ColumnWidths
|
||||||
|
|
||||||
|
' add header elements
|
||||||
|
hdr.clear
|
||||||
|
hdr.AddItem
|
||||||
|
For i = 0 To UBound(cols, 1)
|
||||||
|
hdr.list(0, i) = cols(i)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
' make it pretty
|
||||||
|
'body.ZOrder (1)
|
||||||
|
'lbHEAD.ZOrder (0)
|
||||||
|
hdr.SpecialEffect = fmSpecialEffectFlat
|
||||||
|
'hdr.BackColor = RGB(200, 200, 200)
|
||||||
|
hdr.Height = 10
|
||||||
|
|
||||||
|
' align header to body (should be done last!)
|
||||||
|
hdr.width = det.width
|
||||||
|
hdr.Left = det.Left
|
||||||
|
hdr.Top = det.Top - (hdr.Height - 1)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
14
changes.frm
14
changes.frm
@ -13,7 +13,7 @@ Attribute VB_GlobalNameSpace = False
|
|||||||
Attribute VB_Creatable = False
|
Attribute VB_Creatable = False
|
||||||
Attribute VB_PredeclaredId = True
|
Attribute VB_PredeclaredId = True
|
||||||
Attribute VB_Exposed = False
|
Attribute VB_Exposed = False
|
||||||
Private X As Variant
|
Private x As Variant
|
||||||
|
|
||||||
Private Sub cbCancel_Click()
|
Private Sub cbCancel_Click()
|
||||||
|
|
||||||
@ -34,7 +34,7 @@ Private Sub lbHist_Change()
|
|||||||
|
|
||||||
For i = 0 To Me.lbHist.ListCount - 1
|
For i = 0 To Me.lbHist.ListCount - 1
|
||||||
If Me.lbHist.Selected(i) Then
|
If Me.lbHist.Selected(i) Then
|
||||||
Me.tbPrint.value = X(i, 7)
|
Me.tbPrint.value = x(i, 7)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
Next i
|
Next i
|
||||||
@ -68,12 +68,12 @@ Private Sub UserForm_Activate()
|
|||||||
Dim fail As Boolean
|
Dim fail As Boolean
|
||||||
|
|
||||||
'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
|
'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
|
||||||
X = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
|
x = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
|
||||||
If fail Then
|
If fail Then
|
||||||
Me.Hide
|
Me.Hide
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
Me.lbHist.list = X
|
Me.lbHist.list = x
|
||||||
|
|
||||||
lbHEAD.ColumnCount = lbHist.ColumnCount
|
lbHEAD.ColumnCount = lbHist.ColumnCount
|
||||||
lbHEAD.ColumnWidths = lbHist.ColumnWidths
|
lbHEAD.ColumnWidths = lbHist.ColumnWidths
|
||||||
@ -88,10 +88,6 @@ Private Sub UserForm_Activate()
|
|||||||
lbHEAD.list(0, 4) = "Comment"
|
lbHEAD.list(0, 4) = "Comment"
|
||||||
lbHEAD.list(0, 5) = "Sales"
|
lbHEAD.list(0, 5) = "Sales"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
' make it pretty
|
' make it pretty
|
||||||
'body.ZOrder (1)
|
'body.ZOrder (1)
|
||||||
'lbHEAD.ZOrder (0)
|
'lbHEAD.ZOrder (0)
|
||||||
@ -120,7 +116,7 @@ Sub delete_selected()
|
|||||||
|
|
||||||
For i = 0 To Me.lbHist.ListCount - 1
|
For i = 0 To Me.lbHist.ListCount - 1
|
||||||
If Me.lbHist.Selected(i) Then
|
If Me.lbHist.Selected(i) Then
|
||||||
Call handler.undo_changes(X(i, 6), fail)
|
Call handler.undo_changes(x(i, 6), fail)
|
||||||
If fail Then
|
If fail Then
|
||||||
MsgBox ("undo did not work")
|
MsgBox ("undo did not work")
|
||||||
Exit Sub
|
Exit Sub
|
||||||
|
BIN
changes.frx
BIN
changes.frx
Binary file not shown.
173
fpvt.frm
173
fpvt.frm
@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
|
|||||||
ClientHeight = 8445.001
|
ClientHeight = 8445.001
|
||||||
ClientLeft = 120
|
ClientLeft = 120
|
||||||
ClientTop = 465
|
ClientTop = 465
|
||||||
ClientWidth = 8820.001
|
ClientWidth = 9285.001
|
||||||
OleObjectBlob = "fpvt.frx":0000
|
OleObjectBlob = "fpvt.frx":0000
|
||||||
StartUpPosition = 1 'CenterOwner
|
StartUpPosition = 1 'CenterOwner
|
||||||
End
|
End
|
||||||
@ -24,6 +24,11 @@ Private load_tb As Boolean
|
|||||||
Private set_Price As Boolean
|
Private set_Price As Boolean
|
||||||
Private sp As Object
|
Private sp As Object
|
||||||
Private basket() As Variant
|
Private basket() As Variant
|
||||||
|
Private vSwap() As Variant
|
||||||
|
Private swapline As Integer
|
||||||
|
Private set_swapalt As Boolean
|
||||||
|
Private return_swap As Boolean
|
||||||
|
Private jswap As Object
|
||||||
|
|
||||||
Private bVol As Double
|
Private bVol As Double
|
||||||
Private bVal As Double
|
Private bVal As Double
|
||||||
@ -66,8 +71,9 @@ End Sub
|
|||||||
Private Sub butAdjust_Click()
|
Private Sub butAdjust_Click()
|
||||||
|
|
||||||
Dim fail As Boolean
|
Dim fail As Boolean
|
||||||
|
Dim doc As String
|
||||||
|
|
||||||
If adjust("source") = "" Then
|
If tbAPI.text = "" Then
|
||||||
MsgBox ("No adjustments provided")
|
MsgBox ("No adjustments provided")
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
@ -77,7 +83,25 @@ Private Sub butAdjust_Click()
|
|||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
|
Select Case fpvt.mp.SelectedItem.Name
|
||||||
|
Case "pageSWAP"
|
||||||
|
doc = tbAPI.text
|
||||||
|
If doc = "" Then
|
||||||
|
MsgBox ("no part swap setup")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Case "pAnn"
|
||||||
|
doc = tbAPI.text
|
||||||
|
If doc = "" Then
|
||||||
|
MsgBox ("no adjustements are ready")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Case Else
|
||||||
|
MsgBox ("not on an adjustable tab")
|
||||||
|
Exit Sub
|
||||||
|
End Select
|
||||||
|
|
||||||
|
Call handler.request_adjust(doc, fail)
|
||||||
If fail Then
|
If fail Then
|
||||||
MsgBox ("adjustment was not made due to error")
|
MsgBox ("adjustment was not made due to error")
|
||||||
Exit Sub
|
Exit Sub
|
||||||
@ -132,19 +156,18 @@ Private Sub cbGoSheet_Click()
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
Private Sub cbTAG_Change()
|
Private Sub cbTAG_Change()
|
||||||
|
|
||||||
|
Dim j As Object
|
||||||
If tbAPI.text = "" Then tbAPI.text = "{}"
|
If tbAPI.text = "" Then tbAPI.text = "{}"
|
||||||
Set adjust = JsonConverter.ParseJson(tbAPI.text)
|
Set j = JsonConverter.ParseJson(tbAPI.text)
|
||||||
adjust("tag") = cbTAG.value
|
j("tag") = cbTAG.value
|
||||||
tbAPI.text = JsonConverter.ConvertToJson(adjust)
|
tbAPI.text = JsonConverter.ConvertToJson(j)
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub Label64_Click()
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub lbMonth_Change()
|
Private Sub lbMonth_Change()
|
||||||
|
|
||||||
@ -181,10 +204,132 @@ Private Sub lbMonth_Change()
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub lheader_Click()
|
Private Sub cbPLIST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
|
||||||
|
If KeyCode <> 13 Then Exit Sub
|
||||||
|
Dim i As Long
|
||||||
|
If set_swapalt Then Exit Sub
|
||||||
|
Dim vtable() As Variant
|
||||||
|
Dim ptable As String
|
||||||
|
|
||||||
|
Dim rx As Object
|
||||||
|
Set rx = CreateObject("vbscript.regexp")
|
||||||
|
rx.Global = True
|
||||||
|
rx.Pattern = " - .*"
|
||||||
|
|
||||||
|
For i = 0 To Me.lbSWAP.ListCount - 1
|
||||||
|
If Me.lbSWAP.Selected(i) Then
|
||||||
|
vSwap(swapline, 2) = rx.Replace(cbPLIST.value, "")
|
||||||
|
return_swap = True
|
||||||
|
lbSWAP.list = vSwap
|
||||||
|
return_swap = False
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
vtable = x.ARRAYp_TransposeVar(vSwap)
|
||||||
|
vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
|
||||||
|
vtable = x.ARRAYp_TransposeVar(vtable)
|
||||||
|
ptable = x.json_from_table_zb(vtable, "rows", False)
|
||||||
|
Set jswap("swap") = JsonConverter.ParseJson(ptable)
|
||||||
|
|
||||||
|
jswap("scenario")("version") = handler.plan
|
||||||
|
jswap("scenario")("iter") = handler.basis
|
||||||
|
jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
jswap("user") = Application.UserName
|
||||||
|
jswap("source") = "adj"
|
||||||
|
jswap("message") = tbCOM.text
|
||||||
|
jswap("tag") = cbTAG.text
|
||||||
|
jswap("type") = "swap"
|
||||||
|
|
||||||
|
tbAPI.text = JsonConverter.ConvertToJson(jswap)
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Private Sub dbGETSWAP_Click()
|
||||||
|
|
||||||
|
Dim doc As String
|
||||||
|
Dim j As Object
|
||||||
|
Dim fail As Boolean
|
||||||
|
Dim l() As Variant
|
||||||
|
Dim ptable As String
|
||||||
|
Dim vtable() As Variant
|
||||||
|
|
||||||
|
Set j = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
|
||||||
|
'Set j = JsonConverter.ParseJson(doc)
|
||||||
|
j("new_mold") = pickSWAP.text
|
||||||
|
doc = JsonConverter.ConvertToJson(j)
|
||||||
|
vSwap = handler.get_swap_fit(doc, fail)
|
||||||
|
lbSWAP.list = vSwap
|
||||||
|
'Call x.frmListBoxHeader(lbSWAPH, lbSWAP, "Original", "Sales", "Replacement", "Fit")
|
||||||
|
|
||||||
|
cbPLIST.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
|
||||||
|
|
||||||
|
'---------build change-------------
|
||||||
|
Set jswap = j
|
||||||
|
vtable = x.ARRAYp_TransposeVar(vSwap)
|
||||||
|
vtable = x.ARRAYp_zerobased_addheader(vtable, "original", "sales", "replace", "fit")
|
||||||
|
vtable = x.ARRAYp_TransposeVar(vtable)
|
||||||
|
ptable = x.json_from_table_zb(vtable, "rows", False)
|
||||||
|
Set jswap("swap") = JsonConverter.ParseJson(ptable)
|
||||||
|
|
||||||
|
jswap("scenario")("version") = handler.plan
|
||||||
|
jswap("scenario")("iter") = handler.basis
|
||||||
|
jswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
jswap("user") = Application.UserName
|
||||||
|
jswap("source") = "adj"
|
||||||
|
jswap("message") = tbCOM.text
|
||||||
|
jswap("tag") = cbTAG.text
|
||||||
|
jswap("type") = "swap"
|
||||||
|
|
||||||
|
tbAPI.text = JsonConverter.ConvertToJson(jswap)
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub lbSWAP_Change()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
If return_swap Then Exit Sub
|
||||||
|
|
||||||
|
For i = 0 To Me.lbSWAP.ListCount - 1
|
||||||
|
If Me.lbSWAP.Selected(i) Then
|
||||||
|
set_swapalt = True
|
||||||
|
cbPLIST.value = vSwap(i, 2)
|
||||||
|
set_swapalt = False
|
||||||
|
swapline = i
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub lbSWAP_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
|
||||||
|
|
||||||
|
' Dim rx As Object
|
||||||
|
' Set rx = CreateObject("vbscript.regexp")
|
||||||
|
' rx.Global = True
|
||||||
|
' rx.Pattern = " - .*"
|
||||||
|
' Dim match As Object
|
||||||
|
' Dim i As Long
|
||||||
|
' Dim v As Variant
|
||||||
|
'
|
||||||
|
' 'v = Me.lbSWAP.list
|
||||||
|
'
|
||||||
|
' For i = 0 To Me.lbSWAP.ListCount - 1
|
||||||
|
' If Me.lbSWAP.Selected(i) Then
|
||||||
|
' part.Show
|
||||||
|
' If Not part.useval Then
|
||||||
|
' Exit Sub
|
||||||
|
' End If
|
||||||
|
' 'vSwap(i, 3) = rx.Execute(part.cbPart.value)
|
||||||
|
' 'v(i, 2) = rx.Replace(part.cbPart.value, "")
|
||||||
|
' 'Me.lbSWAP.list = v
|
||||||
|
' End If
|
||||||
|
' Next i
|
||||||
|
'
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
Private Sub opEditPrice_Click()
|
Private Sub opEditPrice_Click()
|
||||||
|
|
||||||
opPlugVol.Enabled = False
|
opPlugVol.Enabled = False
|
||||||
@ -425,6 +570,7 @@ Private Sub UserForm_Activate()
|
|||||||
Me.lheader = "Loading..."
|
Me.lheader = "Loading..."
|
||||||
|
|
||||||
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
||||||
|
Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
|
||||||
|
|
||||||
Me.lheader = "Ready"
|
Me.lheader = "Ready"
|
||||||
|
|
||||||
@ -584,6 +730,13 @@ Private Sub UserForm_Activate()
|
|||||||
sbpp.value = 0
|
sbpp.value = 0
|
||||||
sbpd.value = 0
|
sbpd.value = 0
|
||||||
|
|
||||||
|
'--------reset swap tab-------------------------------
|
||||||
|
lbSWAP.clear
|
||||||
|
pickSWAP.value = ""
|
||||||
|
pickSWAP.text = ""
|
||||||
|
pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F1672"))
|
||||||
|
Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
|
||||||
|
|
||||||
Call handler.month_tosheet(month, basket)
|
Call handler.month_tosheet(month, basket)
|
||||||
Application.StatusBar = False
|
Application.StatusBar = False
|
||||||
|
|
||||||
|
58
handler.bas
58
handler.bas
@ -5,7 +5,7 @@ Public sql As String
|
|||||||
Public jsql As String
|
Public jsql As String
|
||||||
Public scenario As String
|
Public scenario As String
|
||||||
Public sc() As Variant
|
Public sc() As Variant
|
||||||
Public X As New TheBigOne
|
Public x As New TheBigOne
|
||||||
Public wapi As New Windows_API
|
Public wapi As New Windows_API
|
||||||
Public data() As String
|
Public data() As String
|
||||||
Public agg() As String
|
Public agg() As String
|
||||||
@ -26,7 +26,7 @@ Sub load_fpvt()
|
|||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim s_tot As Object
|
Dim s_tot As Object
|
||||||
|
|
||||||
fpvt.ListBox1.list = handler.sc
|
fpvt.lbSDET.list = handler.sc
|
||||||
|
|
||||||
showprice = False
|
showprice = False
|
||||||
|
|
||||||
@ -182,7 +182,7 @@ Sub pg_main_workset(rep As String)
|
|||||||
ReDim str(UBound(res, 1), UBound(res, 2))
|
ReDim str(UBound(res, 1), UBound(res, 2))
|
||||||
|
|
||||||
Worksheets("data").Cells.ClearContents
|
Worksheets("data").Cells.ClearContents
|
||||||
Call X.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
|
Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
@ -309,7 +309,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
|||||||
i = i + 1
|
i = i + 1
|
||||||
Loop
|
Loop
|
||||||
|
|
||||||
Call X.SHTp_DumpVar(res, "data", i, 1, False, False, True)
|
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)
|
'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
|
||||||
@ -453,8 +453,8 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
|||||||
|
|
||||||
'basket
|
'basket
|
||||||
sh.Range("U1:AC100000").ClearContents
|
sh.Range("U1:AC100000").ClearContents
|
||||||
Call X.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
|
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
|
||||||
Call X.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
|
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
|
||||||
Sheets("config").Cells(5, 2) = 0
|
Sheets("config").Cells(5, 2) = 0
|
||||||
Sheets("config").Cells(6, 2) = 0
|
Sheets("config").Cells(6, 2) = 0
|
||||||
Sheets("config").Cells(7, 2) = 0
|
Sheets("config").Cells(7, 2) = 0
|
||||||
@ -589,3 +589,49 @@ Sub history()
|
|||||||
changes.Show
|
changes.Show
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Function get_swap_fit(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 & "/swap_fit", 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, 3)
|
||||||
|
|
||||||
|
For i = 0 To UBound(res, 1)
|
||||||
|
res(i, 0) = json("x")(i + 1)("part")
|
||||||
|
res(i, 1) = json("x")(i + 1)("value_usd")
|
||||||
|
res(i, 2) = json("x")(i + 1)("swap")
|
||||||
|
res(i, 3) = json("x")(i + 1)("fit")
|
||||||
|
Next i
|
||||||
|
|
||||||
|
get_swap_fit = res
|
||||||
|
|
||||||
|
End Function
|
||||||
|
34
months.cls
34
months.cls
@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = True
|
|||||||
Attribute VB_Exposed = True
|
Attribute VB_Exposed = True
|
||||||
Option Explicit
|
Option Explicit
|
||||||
|
|
||||||
Private X As New TheBigOne
|
Private x As New TheBigOne
|
||||||
Private units() As Variant
|
Private units() As Variant
|
||||||
Private price() As Variant
|
Private price() As Variant
|
||||||
Private sales() As Variant
|
Private sales() As Variant
|
||||||
@ -126,11 +126,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
|||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
|
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
|
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||||
cancel = True
|
Cancel = True
|
||||||
Call Me.basket_pick(Target)
|
Call Me.basket_pick(Target)
|
||||||
Target.Select
|
Target.Select
|
||||||
End If
|
End If
|
||||||
@ -146,10 +146,10 @@ Sub picker_shortcut()
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, cancel As Boolean)
|
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
|
If Not Intersect(Target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||||
cancel = True
|
Cancel = True
|
||||||
Call Me.basket_pick(Target)
|
Call Me.basket_pick(Target)
|
||||||
Target.Select
|
Target.Select
|
||||||
End If
|
End If
|
||||||
@ -361,7 +361,7 @@ Sub set_sheet()
|
|||||||
Range("H18:L18").FormulaR1C1 = tprice
|
Range("H18:L18").FormulaR1C1 = tprice
|
||||||
Range("N18:R18").FormulaR1C1 = tsales
|
Range("N18:R18").FormulaR1C1 = tsales
|
||||||
Range("T6:U18").ClearContents
|
Range("T6:U18").ClearContents
|
||||||
Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
||||||
'Sheets("month").Range("B32:Q5000").ClearContents
|
'Sheets("month").Range("B32:Q5000").ClearContents
|
||||||
|
|
||||||
If Me.newpart Then
|
If Me.newpart Then
|
||||||
@ -388,7 +388,7 @@ Sub load_sheet()
|
|||||||
tsales = Range("N18:R18")
|
tsales = Range("N18:R18")
|
||||||
'reset basket
|
'reset basket
|
||||||
Sheets("_month").Range("U1:X10000").ClearContents
|
Sheets("_month").Range("U1:X10000").ClearContents
|
||||||
Call X.SHTp_DumpVar(X.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
|
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
|
||||||
ReDim adjust(12)
|
ReDim adjust(12)
|
||||||
Call Me.crunch_array
|
Call Me.crunch_array
|
||||||
Call Me.set_sheet
|
Call Me.set_sheet
|
||||||
@ -620,9 +620,9 @@ Sub build_json()
|
|||||||
'np("basket") = x.json_from_table(b, "basket", False)
|
'np("basket") = x.json_from_table(b, "basket", False)
|
||||||
'get the basket from the sheet
|
'get the basket from the sheet
|
||||||
b = Worksheets("_month").Range("U1").CurrentRegion.value
|
b = Worksheets("_month").Range("U1").CurrentRegion.value
|
||||||
Set m = JsonConverter.ParseJson(X.json_from_table(b, "basket", False))
|
Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
|
||||||
If UBound(b, 1) <= 2 Then
|
If UBound(b, 1) <= 2 Then
|
||||||
Set np("basket") = JsonConverter.ParseJson("[" & X.json_from_table(b, "basket", False) & "]")
|
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
|
||||||
Else
|
Else
|
||||||
Set np("basket") = m("basket")
|
Set np("basket") = m("basket")
|
||||||
End If
|
End If
|
||||||
@ -687,7 +687,7 @@ Sub crunch_array()
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub cancel()
|
Sub Cancel()
|
||||||
|
|
||||||
Sheets("Orders").Select
|
Sheets("Orders").Select
|
||||||
|
|
||||||
@ -727,7 +727,7 @@ Sub print_basket()
|
|||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim basket() As Variant
|
Dim basket() As Variant
|
||||||
basket = X.SHTp_get_block(Sheets("_month").Range("U1"))
|
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
|
||||||
|
|
||||||
dumping = True
|
dumping = True
|
||||||
|
|
||||||
@ -840,7 +840,7 @@ Sub get_edit_basket()
|
|||||||
dumping = False
|
dumping = False
|
||||||
|
|
||||||
Worksheets("_month").Range("U2:X5000").ClearContents
|
Worksheets("_month").Range("U2:X5000").ClearContents
|
||||||
Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
||||||
|
|
||||||
If Me.newpart Then
|
If Me.newpart Then
|
||||||
Me.build_json
|
Me.build_json
|
||||||
@ -911,7 +911,7 @@ Sub build_new()
|
|||||||
'Call Me.set_sheet
|
'Call Me.set_sheet
|
||||||
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
'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"))
|
basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
|
||||||
Sheets("month").Cells(32, 2) = basket(1, 1)
|
Sheets("month").Cells(32, 2) = basket(1, 1)
|
||||||
Sheets("month").Cells(32, 6) = basket(1, 2)
|
Sheets("month").Cells(32, 6) = basket(1, 2)
|
||||||
Sheets("month").Cells(32, 12) = basket(1, 3)
|
Sheets("month").Cells(32, 12) = basket(1, 3)
|
||||||
@ -934,8 +934,8 @@ Sub new_part()
|
|||||||
|
|
||||||
'---------build customer mix-------------------------------------------------------------------
|
'---------build customer mix-------------------------------------------------------------------
|
||||||
|
|
||||||
cust = X.SHTp_Get("_month", 1, 27, True)
|
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
|
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
|
||||||
MsgBox ("error building customer mix")
|
MsgBox ("error building customer mix")
|
||||||
End If
|
End If
|
||||||
|
|
||||||
@ -979,8 +979,8 @@ Sub new_part()
|
|||||||
i = i + 1
|
i = i + 1
|
||||||
Loop
|
Loop
|
||||||
Worksheets("_month").Range("U2:AC10000").ClearContents
|
Worksheets("_month").Range("U2:AC10000").ClearContents
|
||||||
Call X.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
||||||
Call X.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
|
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
|
||||||
|
|
||||||
'------reset volume to copy base to forecsat and clear base------------------------------------
|
'------reset volume to copy base to forecsat and clear base------------------------------------
|
||||||
|
|
||||||
|
@ -13,7 +13,7 @@ Private Sub Worksheet_Activate()
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
|
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||||
|
|
||||||
If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
|
If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
|
||||||
Exit Sub
|
Exit Sub
|
||||||
@ -25,7 +25,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean
|
|||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
cancel = True
|
Cancel = True
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim j As Long
|
Dim j As Long
|
||||||
|
Loading…
Reference in New Issue
Block a user