From 7e57d4621fcaaedcdce7e25535ec91ddc192cb7f Mon Sep 17 00:00:00 2001 From: Trowbridge Date: Thu, 5 Mar 2020 01:08:10 -0500 Subject: [PATCH] add a new route for swapping out parts --- TheBigOne.cls | 140 ++++++++++++++++++++++++++++++++++++++-- changes.frm | 14 ++-- changes.frx | Bin 3096 -> 3096 bytes fpvt.frm | 173 +++++++++++++++++++++++++++++++++++++++++++++++--- fpvt.frx | Bin 21016 -> 22552 bytes handler.bas | 58 +++++++++++++++-- months.cls | 34 +++++----- openf.frx | Bin 3096 -> 3096 bytes part.frx | Bin 2584 -> 2584 bytes pivot.cls | 4 +- 10 files changed, 374 insertions(+), 49 deletions(-) diff --git a/TheBigOne.cls b/TheBigOne.cls index 4c73533..d5ac3ba 100644 --- a/TheBigOne.cls +++ b/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 + diff --git a/changes.frm b/changes.frm index a54c945..03ac51d 100644 --- a/changes.frm +++ b/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 diff --git a/changes.frx b/changes.frx index 46f046fdeb8b05efd16c4fc9414c4ba9e7327594..7115a1e2d53bfb255663634fcfe223f70fdf26ff 100644 GIT binary patch delta 26 icmbOsF+*ZQ3kw^A^i9VtpEh@~ykKU0ySbQSDKh|xOA2ZL delta 26 icmbOsF+*ZQ3k#dVrJ}eyA2)ZgykKVhxVe~PDKh|-Fbg68 diff --git a/fpvt.frm b/fpvt.frm index 10abfd9..5c04c65 100644 --- a/fpvt.frm +++ b/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 diff --git a/fpvt.frx b/fpvt.frx index 56d721c13797c27d8dce9ca104b4718bdbc958fc..440fa2b1b51fe374430ac4294c195a3af2d6c860 100644 GIT binary patch delta 3990 zcma)<3s98T702)Wc0U3u5EcO!MEI6B3o45Xth`(l5#_ZCf<_ZvmW^Q61r?%}8n!W- z`ijAmwi>6#G&atp(?ng#MhrJ7TodB=CG@IY z)B629x#vY0ddvzCHA!F+Doq zy@+yE9KB;)E32tQ?KK?Rc9RaNx_57@MN-gT)m){#gi@kv8u*P?VLBHEO%fL2?{06b zUxEsrG2PW1@dsFEJ)WdP@6q+@=Xdz^+A$-okIEknT3$L3C9{OFSTx2a#j;hSONcm( z92*nDj_8W5Lfn}Xs*GNu$cv%9rhmy~;qI(I^|wpXfZkx4ZcjW)qoz4@Io2tO%yGl& zn`k~wqj7Drgnk=0HC|k8*T)>+vlNm{@uf9cP)Pth31$@W;6acC%peg=1}PvJOaZCD z0*tgJJ~P*fQa1R{*w|POWG=`9`G9v(A+Uu`#IKNKNf=bw;9VL`7*=_z>tr@J&6tD| zMvt-K+kLh(AEul$A3h*n5nYSg&?LtFUj1GN`@PHDX^TNC`*lC{u-YX#a9dY5B`&Vl z&GQueuJ;=g)*T;niI;5R=@VsQwx~dGXP26Ult>!Edx+!p|83E(#3yAe#ZBHO8_Aqh zH1cx{<2UAju?dzOa(0bF&UJn@UIGp|*E#GgIYMcGw{tp}1~LHmX^^}ayrjG!ycpch zi@}n?VwCBXqDbR($QhAx2_%w7l!952Hr`o0kZvbgqPb9u21-ay8sWeM81Hz=V;-Rpe_&?^1!bLkh75k zld~=8_62(S0&BE+y`I1t-^ME#8*Ja?VUIuaaC?WRdlt)ZvM-zLP&1*^OQWexDra## zdE$yx&d;MXnmep=<_2hV^03O;=tt@`sl46Hx*lh#gGLjFWiG{~j>ws`H?>Vq(q!(J z#T1v;mB%@)X_mn1zn?Q7`T&W!`WZb##xrd^G1HdJ;9bj8@-F-wLrhaUZM?bp9sZYk zB$qjtZ0x97g8>Khm*!WUsykawanri;cst+E)c7gl8V;W#)0WKORN^$^Y`EVL_cvJe zk_<~SWpvs&<2aC?LmkelyfgIZ%Z;=*vrWz5q3mqV8k8<8_`!oUbwt+IsfO3sUc#Rr zyU9wQOv#MlO{Rku&1KBNmqNrog3-n|g}B9s;Z`BWcN%K?154sGm$vg_S;Tb+%z{IA zxt1xdv_-S~_&gAzSob4G@VUo(b2jQ$=o(NPsBf950O052+xV=x%`GVb+Pp=9MeSsdW#WU#b^=+(==Bt9m>*K3Jom7MHMoewQ=Uggc zX95M9v~2#2YkJU;SGbW3_&r|VI$vN=Yw7p*+`!u(qZ9UN7R35KM$*&SNES|q$mIn) zG#E}at=;GMc?W$xn%lEs5Z8{psp+CSa`E8x7{7D`;leVWBb|M*h}Bl9J8DokorBbjnhUxyF8q1ygX$%2tMNN6L}D5QNSznw8RlrpkEj8F2Q98YBib_d<}ZK z7tHVAsNw{(NJb)q)q`A?P}}385b7^FGF^7e`PXMh6@H2NZclSEA16x(gWa zS!wok`}`HN#6{GZaigsJaKxwzquy?J^TPHHF%4;QuT9>6Y_lFjP1tmZPFB9x=n5$F zTgmWc34S*ESm&R51V6njbwwsOPUwYgt$%=4mDzCio>aU(I%~~Izc-#7nqnYiw~u18 zGK^kKKx58SI9zR`EvT*xMl1{#dD*b+H%aa`+BKomhSC*XCkLfGU8jNK@<&vT znrF6M8#P z`nv8h-wkH!dc31>*yau=VIS)sQV3y&&n1v_tm zT0`#-XACK2{h`vClaSa$p*ba$5;y9AAsv0^=TuScf)(`bax0ZLC(-Zbl~b_UM)5Wi zoh`M}_QE!*o)z<8zkf)#spV;%{eB-kTbLosaU$l?!CC$CCdD`o!=_f79Qu)Ci=?y# zIrO~UA^mjTo+N~41nUJU(rMV5l|*6Qq(-q2=ejil5C zE_Mi`_m$6sopu9KhK`rlDiF8r8Ig`JxExBUpn>Mfu)9^Zs0#7;fPaVv3~A7L1O7X! z%av{?)~JvUR(}K+H`g4~XRCceiqMf-r|kU_;`k)k2A%@j0bf#{hWs+v33h?qU=QHF zXCm@h$WgE#5O@xJ1$-5J4IBUm0gs_zy_WD&r1H)2#^d!`$!n+_2PeQu5CS~nb;$34 z?}G1v?}HzJ{qvKSa{pT>{{*}ZehS_JXTZRJ?Y=>+)wjt{r<=2AM@uoCYcbJ>_Gnt!GJ}5HkVxq*Hd#hjn~UgV zONAnO=!J$%s%AZX7?02J~ug3<31$+ E3p*I(N&o-= delta 3072 zcma);e^6Xk702&=yUULa5EhoO3mbU+3@l{%5g-c*KSIb4euUpFsm00*Yy-)%O9G_L zkd$qLHMS*ob6O>K?2u_}9cOIQuGOfcqK=(TMx*19G1Sy)ozD1=qd}c2EH7u5E0iih#f7Ejy_$c>>#GtsO!S(fN{#9bJCuNrCJo)xUK>Tf zFmy;k4r4)vc16zeZ1%Wdu|ZLU0^I;o%Y^t%EVXAlWEK6uXs3a=LaH-Ir|`odTdiG7 z67m`P!05ojm!SV4flQ`jvVq1;BWz2*Gv&ja3{geWMA7tmlKnR;? z8=aVJ3_Ol`h3GKQa@4k$ZP79m3}y>su{aoKjq5=iV}lU!@LXLLA}tQ4XNCCr?r=>^ zw<3QUo-_YLrrdq|UxRm6Zb_b9=;4HTltSiux*g}1$H@{uZF(J#W+@ckA&cpQ`1FL% zhI_itf`NU>oKRky1(VHyC&7#&0ayUCFOoqLu!1ch1sFjpumL-rPRO)pL%YAax|#!- z3-Uld*hVwamqWpuWJ{bhakwQ4B~F`ol0~vuT3u#n@LT1ucSoIX-`R50^3uHcrs!|! zz>tWncKjl*nx3|JoXDoW+6S4hncb4Xw{&xJQdf!O@UigWw|kJ!n(fCv$>-!InoB+} zcT>ndZQ>X8k;Pgx^L=Rik{pO7r-{?XI;V@%#OdODejk<$r-^0Sx^zHpUDq=qRlr*i zNg^kZ?ezpg=SCCxz1jnKyl-9hLvmF=1U>^E1_R);;1TdSFbFijenUbu zi(%Y&!K2_P7y+Z;7&s2taBN)$AjiQ8a1u;_Nx(MrrxaTvD`*UTUQ0QY9B zQ7Cc~M&e0}FEVjcRgfilT3RVSea4i5dsLpS)ugu}+sJf^cl76Tji{>4Klt~XmKT4C z9vQqSF(e{IAL$WCw~Jei%aMb93K#QMkCQ7m{r{Lp+6paV*B8qfoYxo2=R>N#*gT5Q z?9b;~ebCIGZ0O8x7iWOCVB7z2`NaE~RgcpS)7(#Kj>YECoP9U&dSOD*8}P*QU+|o7uVDCtjtQ3uuXi39pJG=TF%bIJpartb85ay zj1=pUbHy!KpaO%{xX*&EK}3sA?WniBYRF4xavW6Mnn?}jSUSAzO-1ujTtTiQ1I73I ztvt=z#oNrO7IN$qwH0Jw#w9`Z^>%u{(?atFmnhAUOYMbLauz!2*}~ynkq956@c-Df zR{tMygr_80Yi(6{6nqb%bFeCjLx2BCZOmICsK~X=sQG?dM_bINOug_K*AK#WXlM1k z=9OjY#d{Fi2w8AU?%%MhgSM>OsnD|Zny94s?K7qw5gYT%&{p&Wk;j#*a3)+%`53+G zDpCR>yyR+89Uh$|wZcjF-3jvJ?#Y3Bo*wuGnk$_#Q6#YGi_rE_D67?!53N97 zCA@R6tu7Di!6jzq}%zS&GXB|`q&N#x>Ax%j>be|sWuXzGZp!=oL1dg z^mt>OkxyK@(3np@YBQ6u(x+tX3ZJapBo*&Oc&4gG8rWqaZ!2AH=rtg`80Q(ld3mh7i9)v=q8jGyW}IXdK3^Hop4w?e-z$)X?TIZz}q zv|Js)-`nQ7j6^>J5Ubkq%*YX>bW!x&OsbkMx zy5F{&wc3`L9XtQ)VVOCNmTQL)ytXbIdq7&9M+U;z>uRMUhUqW6>&fLFgzvAqc5cLa z*f2gig!ef{@9r6(a~170+vp^Jb1}W!_?{f1>w8~aTjvw9D*S$vThc;9dAQ}^JJK-X zRVmbGrNWjyx<1xYBvrC_tl@99OiH@q-Z}ClQgaTR2eaVw;3@D0Z~^eq|1{(?;8`#S zE`l$C=RgQt0&K@U%ks;RUjg&rGWaT>;C@yAj$Fmf*TE}1cx}I0${yEn^9Fbmgu%DL zTi`q3yWl$b9$?!`2dtJw=s#J%{~62BiNDc;+ezozZc|!&J#BY47_hx4hexR0tzs;P z&bCiT5ngG31=S|85RW16g_*L!!+ zYrUJPuQx9V$CqN&O9`h#Fi$(;rNv$j5;9kjy{}&e=|tZR{KrkKPoXYPs&vyzi#2@K d^P)_S6d@mZ-Ck|@w6BValpM3>6H2Zg^FM{qI#U1u diff --git a/handler.bas b/handler.bas index f6c56ce..c2d5e8f 100644 --- a/handler.bas +++ b/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 diff --git a/months.cls b/months.cls index 3236de0..ac822ec 100644 --- a/months.cls +++ b/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------------------------------------ diff --git a/openf.frx b/openf.frx index 047e2646ccb06bdf972fd80b27c0cdf23b403e42..0e5b8194d6c4c12deae760a55956666da2a791a3 100644 GIT binary patch delta 56 zcmbOsF+*ZQ3kzGqq1$d-K5gz|dBH57&%mI<@RX5(ft7)wfr){E!2*aG7$g~zlU#y* L6E{!fXlDih^Melr delta 56 zcmbOsF+*ZQ3k%zZEMbw>$D6xYUNFliGcc$yJY{5HU}a!vU}9ikumEBP21$nGB$r@c Krp*&M+L-~j9t~Ll diff --git a/part.frx b/part.frx index 87a61818e5d19f3236da98848161fea72a86cb19..b808753c65c970572d03a7e34c1436ea3a8d4917 100644 GIT binary patch delta 26 icmbOsGDBoT3kzF8V6*p@Pn)|~UNAG}Z!YFo$_N0AK?*zo delta 26 icmbOsGDBoT3k#b;-*K_l$D6xYUNAF;Z7$|m$_N072nq23 diff --git a/pivot.cls b/pivot.cls index 04baf29..31a08c8 100644 --- a/pivot.cls +++ b/pivot.cls @@ -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