add a new route for swapping out parts
This commit is contained in:
Trowbridge
parent
f569e6238d
commit
7e57d4621f
140
TheBigOne.cls
140
TheBigOne.cls
@ -459,6 +459,43 @@ Sub ARRAYp_Transpose(ByRef a() As String)
|
||||
|
||||
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()
|
||||
|
||||
@ -1461,11 +1498,11 @@ End Function
|
||||
Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITLE As String = "") As Boolean
|
||||
|
||||
Application.EnableCancelKey = xlDisabled
|
||||
MsgB.tbMSG.Text = Message
|
||||
MsgB.tbMSG.text = Message
|
||||
MsgB.Caption = TITLE
|
||||
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
|
||||
MsgB.Show
|
||||
MISC_msgbox_cancel = MsgB.cancel
|
||||
MISC_msgbox_cancel = MsgB.Cancel
|
||||
Application.EnableCancelKey = xlInterrupt
|
||||
|
||||
End Function
|
||||
@ -2037,7 +2074,7 @@ Function json_concat(list As Range) As String
|
||||
|
||||
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
|
||||
@ -2045,7 +2082,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, tri
|
||||
Dim sql As String
|
||||
Dim rec As String
|
||||
|
||||
sql = "INSERT INTO " & target & " VALUES " & vbCrLf
|
||||
sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
|
||||
For i = start To ending
|
||||
rec = ""
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
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 BaseSize As Integer
|
||||
BaseSize = Len(sNewBaseDigits)
|
||||
Do While Val(d) <> 0
|
||||
Do While val(d) <> 0
|
||||
tmp = d
|
||||
i = 0
|
||||
Do While tmp >= BaseSize
|
||||
@ -2598,3 +2699,32 @@ Function TBLp_VarToString(ByRef t() As Variant) As String()
|
||||
TBLp_VarToString = x
|
||||
|
||||
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_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Private X As Variant
|
||||
Private x As Variant
|
||||
|
||||
Private Sub cbCancel_Click()
|
||||
|
||||
@ -34,7 +34,7 @@ Private Sub lbHist_Change()
|
||||
|
||||
For i = 0 To Me.lbHist.ListCount - 1
|
||||
If Me.lbHist.Selected(i) Then
|
||||
Me.tbPrint.value = X(i, 7)
|
||||
Me.tbPrint.value = x(i, 7)
|
||||
Exit Sub
|
||||
End If
|
||||
Next i
|
||||
@ -68,12 +68,12 @@ Private Sub UserForm_Activate()
|
||||
Dim fail As Boolean
|
||||
|
||||
'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
|
||||
Me.Hide
|
||||
Exit Sub
|
||||
End If
|
||||
Me.lbHist.list = X
|
||||
Me.lbHist.list = x
|
||||
|
||||
lbHEAD.ColumnCount = lbHist.ColumnCount
|
||||
lbHEAD.ColumnWidths = lbHist.ColumnWidths
|
||||
@ -88,10 +88,6 @@ Private Sub UserForm_Activate()
|
||||
lbHEAD.list(0, 4) = "Comment"
|
||||
lbHEAD.list(0, 5) = "Sales"
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
' make it pretty
|
||||
'body.ZOrder (1)
|
||||
'lbHEAD.ZOrder (0)
|
||||
@ -120,7 +116,7 @@ Sub delete_selected()
|
||||
|
||||
For i = 0 To Me.lbHist.ListCount - 1
|
||||
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
|
||||
MsgBox ("undo did not work")
|
||||
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
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 8820.001
|
||||
ClientWidth = 9285.001
|
||||
OleObjectBlob = "fpvt.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
@ -24,6 +24,11 @@ Private load_tb As Boolean
|
||||
Private set_Price As Boolean
|
||||
Private sp As Object
|
||||
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 bVal As Double
|
||||
@ -66,8 +71,9 @@ End Sub
|
||||
Private Sub butAdjust_Click()
|
||||
|
||||
Dim fail As Boolean
|
||||
Dim doc As String
|
||||
|
||||
If adjust("source") = "" Then
|
||||
If tbAPI.text = "" Then
|
||||
MsgBox ("No adjustments provided")
|
||||
Exit Sub
|
||||
End If
|
||||
@ -77,7 +83,25 @@ Private Sub butAdjust_Click()
|
||||
Exit Sub
|
||||
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
|
||||
MsgBox ("adjustment was not made due to error")
|
||||
Exit Sub
|
||||
@ -132,19 +156,18 @@ Private Sub cbGoSheet_Click()
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub cbTAG_Change()
|
||||
|
||||
|
||||
Dim j As Object
|
||||
If tbAPI.text = "" Then tbAPI.text = "{}"
|
||||
Set adjust = JsonConverter.ParseJson(tbAPI.text)
|
||||
adjust("tag") = cbTAG.value
|
||||
tbAPI.text = JsonConverter.ConvertToJson(adjust)
|
||||
Set j = JsonConverter.ParseJson(tbAPI.text)
|
||||
j("tag") = cbTAG.value
|
||||
tbAPI.text = JsonConverter.ConvertToJson(j)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Label64_Click()
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub lbMonth_Change()
|
||||
|
||||
@ -181,10 +204,132 @@ Private Sub lbMonth_Change()
|
||||
|
||||
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
|
||||
|
||||
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()
|
||||
|
||||
opPlugVol.Enabled = False
|
||||
@ -425,6 +570,7 @@ Private Sub UserForm_Activate()
|
||||
Me.lheader = "Loading..."
|
||||
|
||||
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
||||
Call x.frmListBoxHeader(Me.lbSHDR, Me.lbSDET, "Field", "Selection")
|
||||
|
||||
Me.lheader = "Ready"
|
||||
|
||||
@ -584,6 +730,13 @@ Private Sub UserForm_Activate()
|
||||
sbpp.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)
|
||||
Application.StatusBar = False
|
||||
|
||||
|
||||
58
handler.bas
58
handler.bas
@ -5,7 +5,7 @@ Public sql As String
|
||||
Public jsql As String
|
||||
Public scenario As String
|
||||
Public sc() As Variant
|
||||
Public X As New TheBigOne
|
||||
Public x As New TheBigOne
|
||||
Public wapi As New Windows_API
|
||||
Public data() As String
|
||||
Public agg() As String
|
||||
@ -26,7 +26,7 @@ Sub load_fpvt()
|
||||
Dim i As Long
|
||||
Dim s_tot As Object
|
||||
|
||||
fpvt.ListBox1.list = handler.sc
|
||||
fpvt.lbSDET.list = handler.sc
|
||||
|
||||
showprice = False
|
||||
|
||||
@ -182,7 +182,7 @@ Sub pg_main_workset(rep As String)
|
||||
ReDim str(UBound(res, 1), UBound(res, 2))
|
||||
|
||||
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
|
||||
@ -309,7 +309,7 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
||||
i = i + 1
|
||||
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)
|
||||
@ -453,8 +453,8 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||
|
||||
'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)
|
||||
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
|
||||
@ -589,3 +589,49 @@ Sub history()
|
||||
changes.Show
|
||||
|
||||
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
|
||||
Option Explicit
|
||||
|
||||
Private X As New TheBigOne
|
||||
Private x As New TheBigOne
|
||||
Private units() As Variant
|
||||
Private price() As Variant
|
||||
Private sales() As Variant
|
||||
@ -126,11 +126,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
End If
|
||||
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
|
||||
cancel = True
|
||||
Cancel = True
|
||||
Call Me.basket_pick(Target)
|
||||
Target.Select
|
||||
End If
|
||||
@ -146,10 +146,10 @@ Sub picker_shortcut()
|
||||
|
||||
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
|
||||
cancel = True
|
||||
Cancel = True
|
||||
Call Me.basket_pick(Target)
|
||||
Target.Select
|
||||
End If
|
||||
@ -361,7 +361,7 @@ Sub set_sheet()
|
||||
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)
|
||||
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
|
||||
@ -388,7 +388,7 @@ Sub load_sheet()
|
||||
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)
|
||||
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
|
||||
@ -620,9 +620,9 @@ Sub build_json()
|
||||
'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))
|
||||
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) & "]")
|
||||
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
|
||||
Else
|
||||
Set np("basket") = m("basket")
|
||||
End If
|
||||
@ -687,7 +687,7 @@ Sub crunch_array()
|
||||
|
||||
End Sub
|
||||
|
||||
Sub cancel()
|
||||
Sub Cancel()
|
||||
|
||||
Sheets("Orders").Select
|
||||
|
||||
@ -727,7 +727,7 @@ Sub print_basket()
|
||||
|
||||
Dim i As Long
|
||||
Dim basket() As Variant
|
||||
basket = X.SHTp_get_block(Sheets("_month").Range("U1"))
|
||||
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
|
||||
|
||||
dumping = True
|
||||
|
||||
@ -840,7 +840,7 @@ Sub get_edit_basket()
|
||||
dumping = False
|
||||
|
||||
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
|
||||
Me.build_json
|
||||
@ -911,7 +911,7 @@ Sub build_new()
|
||||
'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"))
|
||||
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)
|
||||
@ -934,8 +934,8 @@ Sub new_part()
|
||||
|
||||
'---------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
|
||||
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
|
||||
|
||||
@ -979,8 +979,8 @@ Sub new_part()
|
||||
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)
|
||||
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------------------------------------
|
||||
|
||||
|
||||
@ -13,7 +13,7 @@ Private Sub Worksheet_Activate()
|
||||
|
||||
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
|
||||
Exit Sub
|
||||
@ -25,7 +25,7 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
cancel = True
|
||||
Cancel = True
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
|
||||
Loading…
Reference in New Issue
Block a user