From 85c3269bcc6f98fbbe3d731ff402eba984812a32 Mon Sep 17 00:00:00 2001 From: Trowbridge Date: Tue, 5 Mar 2019 11:41:11 -0500 Subject: [PATCH] save work --- fpvt.frm | 156 +++++++++++++++++++++++++++++++++++++++++-- fpvt.frx | Bin 25624 -> 23576 bytes handler.bas | 186 +++++++++++++++++++++++++++++----------------------- pivot.bas | 41 ++---------- 4 files changed, 258 insertions(+), 125 deletions(-) diff --git a/fpvt.frm b/fpvt.frm index 10f3c6d..6377a73 100644 --- a/fpvt.frm +++ b/fpvt.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt Caption = "Forecast Adjustment" - ClientHeight = 7275 + ClientHeight = 7260 ClientLeft = 120 ClientTop = 465 - ClientWidth = 13695 + ClientWidth = 16140 OleObjectBlob = "fpvt.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -14,11 +14,10 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public mod_adjust As Boolean -Public month() As Variant +Private month() As Variant +Private mload() As Variant Option Explicit - - Private Sub cbCancel_Click() tbAdjVol.value = 0 @@ -45,6 +44,73 @@ Private Sub chbPlug_Change() End Sub +Private Sub lbMonth_Change() + + Dim i As Long + For i = 0 To 12 + If lbMonth.Selected(i) Then + If i <> 0 Then + '------------base------------------------------------- + tbMBaseVal.value = co_num(month(i, 6), 0) + tbMBaseVol.value = co_num(month(i, 2), 0) + tbmPAVal.value = co_num(month(i, 7), 0) + tbMPAVol.value = co_num(month(i, 3), 0) + tbMFVal.value = co_num(month(i, 8), 0) + tbMFVol.value = co_num(month(i, 4), 0) + If tbMBaseVol <> 0 Then + tbMBasePrice = Format(tbMBaseVal / tbMBaseVol, "#.000") + Else + tbMBasePrice = 0 + End If + If tbMFVol <> 0 Then + tbMFPrice = Format(tbMFVal / tbMFVol, "#.000") + Else + tbMFPrice = 0 + End If + Else + tbMBaseVal.value = 0 + tbMBaseVol.value = 0 + tbmPAVal.value = 0 + tbMPAVol.value = 0 + tbMFVal.value = 0 + tbMFVol.value = 0 + tbMBasePrice = 0 + tbMFPrice = 0 + End If + Exit For + End If + Next i + + + +End Sub + + +Private Sub ListBox1_Click() + +End Sub + +Private Sub opmprice_Click() + + tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###") + tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###") + tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000") + +End Sub + +Private Sub opmvol_Click() + + Dim pchange As Double + + '---------calculate percent change---------------------------------------------------------------------- + pchange = 1 + CDbl(tbMAVal.value) / (CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value)) + '---------add the adjustments together to get the new forecast------------------------------------------ + tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###") + tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###") + tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000") + +End Sub + Private Sub opprice_Click() tbFcVal = Format(CDbl(tbPadjVal.value) + CDbl(tbBaseVal.value) + CDbl(tbAdjVal.value), "#,###") @@ -101,11 +167,40 @@ Private Sub tbAdjVol_Change() End Sub +Private Sub tbMAVal_Change() + + Dim pchange As Double + + If IsNumeric(tbMAVal.value) Then + '---------calculate percent change---------------------------------------------------------------------- + pchange = 1 + CDbl(tbMAVal.value) / (CDbl(tbMAVal.value) + CDbl(tbMBaseVal.value)) + '---------add the adjustments together to get the new forecast------------------------------------------ + tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value) + CDbl(tbMAVal.value), "#,###") + '---------if volume adjustment method is selected, scale the volume up---------------------------------- + If opmvol Then + tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)) * pchange, "#,###") + Else + tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###") + End If + tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000") + Else + tbMFVal = Format(CDbl(tbmPAVal.value) + CDbl(tbMBaseVal.value), "#,###") + tbMFVol = Format((CDbl(tbMPAVol.value) + CDbl(tbMBaseVol.value)), "#,###") + tbMFPrice = Format(CDbl(tbMFVal.value) / CDbl(tbMFVol.value), "#.000") + End If + +End Sub + Private Sub UserForm_Activate() Dim sp As Object Dim i As Long + Dim j As Long + Dim k As Long Dim ok As Boolean + + handler.server = "http://10.56.1.20:3000" + 'handler.server = "http://192.168.1.69:3000" Set sp = handler.scenario_package(handler.scenario, ok) @@ -142,10 +237,59 @@ Private Sub UserForm_Activate() '---------------------------------------populate monthly------------------------------------------------------- + k = 0 '--parse json into variant array for loading-- + ReDim month(sp("package")("mpvt").Count, 8) + + For i = 1 To sp("package")("mpvt").Count + month(i, 0) = sp("package")("mpvt")(i)("order_month") + month(i, 1) = Format(sp("package")("mpvt")(i)("2019 qty"), "#,###") + month(i, 2) = Format(sp("package")("mpvt")(i)("2020 base qty"), "#,###") + month(i, 3) = Format(sp("package")("mpvt")(i)("2020 adj qty"), "#,###") + month(i, 4) = Format(sp("package")("mpvt")(i)("2020 tot qty"), "#,###") + month(i, 5) = Format(sp("package")("mpvt")(i)("2019 value_usd"), "#,###") + month(i, 6) = Format(sp("package")("mpvt")(i)("2020 base value_usd"), "#,###") + month(i, 7) = Format(sp("package")("mpvt")(i)("2020 adj value_usd"), "#,###") + month(i, 8) = Format(sp("package")("mpvt")(i)("2020 tot value_usd"), "#,###") + + Next i - + + month(0, 0) = "month" + 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" + + ReDim mload(UBound(month, 1), 5) + For i = 0 To UBound(month, 1) + mload(i, 0) = month(i, 0) + mload(i, 1) = month(i, 1) + mload(i, 2) = month(i, 4) + mload(i, 3) = month(i, 5) + mload(i, 4) = month(i, 8) + Next i + + lbMonth.list = mload + lbMonth.ColumnCount = 8 + + 'MsgBox (lbMonth.list(0, 0)) Application.StatusBar = False 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 + diff --git a/fpvt.frx b/fpvt.frx index 0bb483a1cc7240acff77f30fd7c4ed77f762f35f..7cf124adad2957b810e53ecc4d3a5519cc6d7562 100644 GIT binary patch literal 23576 zcmeHP33OD|8NM?a5HS`a2oX_737gWGWdcdHm;eTpB`B!WYRe=UBrwUuEV$RPO56n% zTgAG7Qe1FfYFn4IR;?RSwY7S>xYnh%dJ1)`m44rS_r7;Cd6{`L8O~^r_na^HE&pBK zz5o8+WX`lfLL4XT^7$b`Y}i|fEzcFay6&z~uh}=$!BmkazSzFA7--z^;dp>PA1cJo zIQ9cyY~Q|}mr0Amugh0x1+ZuF>EV`!NK}ZYu(@@4*hGJ!=(P4Tz5%uH=ZS^krLpEP zk3*u?*B$5OA!xfB5Wq2bBc2bu{tY2c15=cQqn!&no14RJrv&FmJ5OMr6`<`OZPlVvqdzq&&Z0@-~-a^}#|sFPS~rGYsMyh*f*ykKZ~z zYH(_KIG2rr;`gZVL~#x`Mg-7Rm1u6o2}&u}m^5#J21^~^2X!T`_(g$esIQy-(o`W% z+=(;+A>K?N^_p*UM!N=3dNkJ_Ks<>lS_GO zv0=X01IJs>^oi{xbSpk+pFFkBA2#j(_@72>F1Yqeaf>+S@H#f0+tkn&YmY7I2-e2h zn%jeA#U=8H%q9+Pu8%Y}f?4Y7mw{`)3`NTj=6;lb#5T^yDo}ziMS)*XDT~}^xeQWmG zf|G7pe!$(n1&_>LTRU&hp%*@cuBIL|aoCU*_ilapleuf|dw%REE$^IAQXHbqVKRwmzzjXK9G9S^Mac zhPqp87Zty9!~B_7MEBh6HNjTTfGTrFo+?r80b{#uz-o1lY##UFn{B-?M&E+?J zP(16Rdmiil{M0kP$k^jOS&u%HWU@GoE`Fb{`7c=>~ zbRidfj!+ zYr1e6^hXG|QF1S-#{Y|RIFf>VQH zPmBWS7LNw@0uXkJeSjdaFR&jl1{e!)9^+7t2N)Af1oj6G044z}Ao;pvX$5j2f8-qo z4lLP_KLkY#QY2rn&s2qc{GcMD{4p-gw7~!NX}KZ4yXikIce*ym;`o!z3uzwH{~w4p zlvT=M`r}vhYX*by{A5Lj$6VKR$InIl!To9nSWdR8jQ>La_s~aPI^tR(r65Z#7sfqOJvI0<(a_0A8Q1>ba=r0d>H9;0WMIU;(fYAnnnpj{z0|-vN#Vz6%@& z91oD@`>GD3t_K=`Mj!(4{t2j;0!_d&U^x&4c&|m(t*B1~+5qx%2f+I)P@e>lw@(31 z1$g~*RsR6>nLr%K(ElfUj3)00Ke;AZoiF(*k-t8ZjhQ!e@;8aT3wbB4{0$k=%HPcG zjCM5551$Z8nZ)t07Nzmeqzp_zbLy}{fDg!H&YLxJh|9sWkd1gvOG{@Mn*o~m+*nJ; z(&#CqiO+~dqv5vpU|kC?7zHa7Ul^`0S9M6$WK;K&Bv;D$XvoHaBE;{)ir>2-2UISI z-SvDW4gPSK*6`#UE_|VQ6BVyz!~Rk?P$z)Jwxdc}$cvh&3D&n17AVuA?GMK;LMOps zVawuen+vXf7XI(zOC*|%Wnm+%P^+WpTBl~2ogZ?dj(DcVI&&u5iWZ z{vU&RW|9BXj=zq=_&YP`LCJ>y!<-geL(lv_2ef>l%94xqKOEz>%F%TkNXJt!^3 zRK|k)!b|kQ(`|**OF5k+=UpUUSko5k{a;d@%ao7b9L6OvX@!K0D(t zakdXE=d9lsYF+3-*S3Y5BXC9e{lq3Z6b9V@T(dq5P;`|R-A1`yPJj7|&aeBcvgqDt zT%gu@D;8O=a~AxswB>IGrgDbb=WNJd5dG~3&<3DNS*C*GI5mDQrXj8 zKa1;6eNLP1b^Q+n?fe|BKmFufu74NC|1^v1KMwuTr}Mi0P)~;aaq=%Y(VzZG`8^qz zV+ia7ERnQ3IAz&7gPq z5$Yi5xKB_o!j%Bt?8jQ0Td9`w8}WXF$uLC+ofW5@Bi#UtZbd9QMUal)32Qp$(O(8# zB`+a29j%vHb$Qm~Lr}wSl{fJx=l*{Z`^D$S^2TjDgEu^uor$KfGkCBh{r0kp_!!r- zUDOMw>TJm0f#|Cg@G5_IgEp7`-<=pgm-4p}^w7JYb`~>6Y za{YgV@v~|F8Bg&IlGpWL4cc7BpO;{Kz5Y6XA;16ahT4H1HvLbW$pW1tp5f6-5;*=R zb1d{L?feB40c}cRUV{129)4s!UCEPn1!e`_ z`!R6D679-3MQ7P5X{H3}q@8lfhj5g1ifMlmbFa*ayS~3>p2zhE2sDZ+0Y#dWFRww4 zcg1-=5yz3(b5?v3b|TI-m3BSJdt|m_%t#w$*(7|r4a0sDw>L$*^v8=u`#VqCJZa-F z+0^sI+j;eTYT|G8Q5N$pqcaEmPD;||8MGCk z9Rgm~w0aHB=!uC)B8*Oqg)bdD{{VK1^=)mxUsUSyez<)H*Z zQhs;Ax(2!}`K1n}{4%DeEet2f@3e4xBx9K!h=G^@<|lGmwkAVf++=nq&}td5WwxSB zxXJ7w)vqbDQ#QWW!m-u=z#{ght!j{FW^ak&`5bGfrF*~(C`0X zA^DpLsXxZBxzZn&pKJAJ{Jgn1r5>RZu^PLCH#Qxnjowwsu&GC?@EIxf$Vb>&lXi%r z^*K7HtOT^w4T-cv6|JF1%1V`P(6rh{4>ROF&$j24uKH;>Xsa=+fH4Q^3RCYfxkSHa zcSSqEpe=_x?54{`DB6JrZ3xfi=6{R?t=3OF+4HS()n(jJO*=@_PA*BN%kVU5m)z^W z6f&7q2jX#+OlDmdCDkPyH`Tn8=}>3hwl9M1P8}cgY$xLiT=LWobgm^}#Sd?Q^#k1k zCfWKw2=qUOuz`#Jkx~2*pbnAogO$W(()BO6R?R^mJ010NYw@b?+#qCO8eAGiRx5V#1q z7~uU?s=gHUWx(aY8sG|m_kWD~O5iGBEpRo!>({9II@H$#>wxvZ4Zw}S2H>XvX>US( zGjI!VE3gT;4Y(b+10c;^s=f#Hy}*6I{lL!v-v2r3UjV-Z9t0i&9tL=?8}+Y%UjvT< zzX2Wtc<%|+zXhHIo>JGIQ8jM=-;}JzkM%W;eaC-TJinvsb*>r`@7SuOaj%E=cni?? z_)si{zL)yS@5N3a`ZwB1I}!HM4)gU=RQ&ic79!AX`F}cooXGadeiZKPbY{el!c+Xn zDBt?x&+*gV$2FaYg8x;ceLpM4bLjr5=omXnI_1ylSWw4oA1FFyKWgLx!!FS#Xj*NT z{smgC=k2&LG}*9A*7$?K99uzKjp;LP?5J;^&xty=&Y|0;=om9%o}i0G6a7xwInIIo zFDV&!u0Po*wDn znAyuedz9lu`S+wZz++yD@*gSdTK)rA&mES3hH^3FUb&BT+qxW?vfdeSQz3sgPuu<@ znA|P@jCfM^YstTIA6@d#RBqH|I{(~JZ@Z7ZWRP=!%-VCX{YT^i6J?OJ@J(%6$A5%_ z(f2!}+{@n%@&Wtfdtw>;wxia)38>PS`xN$HG^Q9gRr^%)PSHN)nkB@UUiCnt{=hUn z#iyW4S(N`!1@oizhxQ-FuyHp0hx5?6=|9jekH#g(e}GG(?6T=UkZx~9XZa7Lv+T0= z3Ftr2F7Ko0Ed2pGX_u|{$eLFB5B%}2wzanZP#$vCOBJB4M&FkIFh49On()3&`!JIg zt>r^V+E_HwI|k+gPf@g%A3<6UIk0`I`rNfw$<3{Rdv;Bzj$;osWo-X5( zd;RD50y-x6@_oO8<%JAuzax`*4#3u04B|!h@zL#$)EOqX1g!kC>3{5y?^oRN&qbJs z^_q>ocx{7@LCo()Xk^BMPRoSthoGV3hdA-dIMt`6N6=><`RDP9&dOocHdvd}JO9k_ uY3%g)whvO(+Xtciav?RX?SqtN{k;)Jv5MjoP7_KK|2Emn|8aKSrT!29s`@bi literal 25624 zcmeHQ34B~d8K2#3OONzO3nf6YTYAs}mh6#>Gi^gGl#)`)A)<7XE^W#t8u zMQ%Yw5VR@}z^la3L|D9vKC#rY zQ&88jXHg+qTbdU>b$}2jZAY2uQU*&fJ6p+=NtyYHj@D#qK~sM@G|3(Sxus|s5<835 zl`V@?Ju3wJYv#2Y{XtC12~jByZR^g=OZP@NHbMl;#ZIU;ogNUIAqaf1xlCQ}#aiF@7}IO3j#mp2`@%lLEeLRSauJA2}|)wgYW`rSpB-u~E(cRSu#FGPbl z5&cXx`p8~=>@nxQb!*clH%^@M@cL)ozj{U81?$#6T5-!N(YJ9{&8+n~pSPYqa1mQ; zSpxP?i;M`1gTTod(IrkUXsDCG82ToYM{<3j+1awyH`I1L@_1k*PWIJW-<)6y_&5%U zU_k3w}r&s+?K(>;NP})S5h*^ie{vzU%*N;$5a(Cy%mzz#G za6`r2Pr|Sgv^M+p#3qo@mpwrv=i#) z`gY?#ZFjmhbx}W3ao>d*7j2fDO1mpue-sH8Q!IaF6!i1jS;zr}>#rWt3_yQ?`w+aR ze+c)J0XUaRu`7yiedf8GNx9dW%ZP=e%Txl=6@cO|5=;-&(HKX^Z_RS^E~;VwdQ{wlm8>I7+!Ey*8}?i`vN?_KWgOs;y|DQmFyM+3(Ip9GEtJ_Q^Hd>TMlE!!0xdH1u`=h+cCbsA!G#&Z3u=4Ld#6@%tFj9TJTAug&PJUP$fN58XS8&fU zJ{8As;&rhW7{|^w(;yYV>~vz%$c=kpt{7=^5n_(B?D?66Gv!UXOhme0QyFgl|j{9_NYO(aw zTlp)DzZg%`MrHth^hZV9pK`R)*Uva$Hy`>-5r5HI=tEhGu>K2`e>(Ipkd|4T`QHKkG1m2}KMdJd0G2k`UM>Ff zTeSUAH)G+#?LUq!15yrCk4eLw|V@ z*FX7;*W`8mb06k7l00+$s#dpj;W{Rves3ws&tKhkPT;T$FMl$T9zmm~!gniH#Rxt`z^6 z`DgClUBUS$Hvsd#KY{Oai^{($aX&(R*7FMHUm@h1GN4uR%;C6yBF+kA%>3yCTnBS3 zJ{4)|O0*|y6RA_t*X|5*j67=?&RMyblB=tYQSMqf4^BQ-uH=Hczj`4k_a-;u^vfrh zykgB?DdOLSxRle>{VzuT$9Qfg;MM*Pg6whj`upF%|1ux?wf&W1{`Z6abBZ|syQ9C^ zfYV3ECgT2 zg_}O)6^!$>M(deWh!eGr&tROG{W+ZL7uzGiI0dBe@0=Wf&ul1X$M%>e%5e_N{{F1w z%5)BZfQfQ_qbRqReDQq@=I~v}9fLC=yk*tg$wyuDdNP@GM+8rmZ(4$9&D@kXG7>-^sYSsnkEBL4e6^p|q}uZ8|%#vj5P4mj&6qu#=eOUZ0E!^2Idxj_(^VmeM|{5fghI<|}V3 zN->|KvXJcRaC2{k$ z`K8HT`AfqXwuClRss#Yqze9$GfT&R>Ig}6JRr^B`G^gVAVj5NqH!RG41CXU$(C9ag zz>u32a$y-`!0$b!Y?&cj4cT#6%UV{Cq0AUVNROeqDn_H#W6-jkP$p#@$1qzqBCZDG zNZBG7FS_2E?02Uv?02$!CP*6?Ai{aC6hMw=R{4Hu@9`W?RU(^lK0wB_oE z7~CckDSe%eE#qfmUbu?$HCPG7rTvb^yoUNL`-MeF`{nxpjD-`^``holM0e7+%?^hm zZlIesTLXJ>v)Sz+t8Kux+3KjP&5lt0nl@XD*Mi+_cBGOuZMN>(d)K(x>?mUlj?KoT zqs_HhPNE*KW3%ymHd}i8n=Ar>hAeLg{U_Mc_McVU>&1F!ZbBREZ+|%H%l^2Y^XSCy z;s@3lhfcq3xu;_B1?@=MU!p2DxE=M@ne8lJ>ZP6E`C+>-VjAb3&>s8Um%MX?0CY(0 zhpOMXZfBkosln$NS(tHuta&aX&tX`uCA6R9KmGig@ylq;H{+Ku8z}x;QO*xmabBG6 z7K8F2+ieeC5a;0*8gauI#X%+y)~ndX3YMJMWvsy~4i8pK9((|^Z1y`&^=t58w5s`` zHRM6vFOvwyPve!W!GlpOA3+|}vN|5&2BzjVhX-q-j9v5?wCn^!*5Se07-N@Q*@=ei za68VabLDu>V*|#wofB(CqdC4qU)v5!c7!3z*wD=%Oj5EV4cRzk-Tc9hkk#`r${ugM zt3TkP(z2tqY)w@@e}JnisFdD+IPsA8{L8U*`V}kxs`eJsfFu0odw$#Xi`imv597oW zl3XrJdc3}Z?mmP=R{r%eOghx}A?9Dm6zq+Ay$SI=&M`kRIm|7N`vc^(9oYO8t2J!g zd7%7)>eJ*e$7UV57nPjBT`@O%eaX;m^H!|RHRs|a>T%k<6|2u@uUnJ-6_$@A?KSGy zphtge*kEBgu~LTEwx2B~ypLD6D|TFQ1}^DL;4I*5U@gGk$9!JZ=b-)~a4v8ja6WJW za3OFJa53;D;1YoCzKr@Sz*m9GfUg0U16KfF2d)IJ0x0`URbP$zTfn!0Yk=6nX1M~qu1AY$N z3)~0%0-)?KRsCz!4*qRZk+o^$Z0OKIX7PA z%DJzpJ`K*TcH`XFm7Kx3HEx{yhN0W$+<3$_M&iWjaoU_4kLKfCPOC1Z=ifZ}D7GZY zckcOf)e!hMkIuZgA$9s~+Z#7y8ks)_z3{IS>kVV9C-)yMnkv5gK^1&xq0wk4Oxc=t0fQS%KpuewR7fpjlu2CGm=e^ZNT&yIdh~6|IC5u zGjz`Uj*>NU=12sxjxTWfWvOXPYv;^(3Ciuc2N#m|2X@XJuk-2; zFrtD=>HUY3&-#g_$rBDgdgoQ03;WSIl(zkN4P*Dl=gz)uLH@(bN>K6JY{+WolnHGkExFno2?UA;{n>qsLwJq4(6>X_;duEAeoU&hXm+Cj2Qu}`T zIVA0z1MWg{=qTuojE-Qo5S!@Layynw%m|)IIJUqhN_ zggu_-8AJA6RQy&CYS8>wK>W7G)AJAhC=c=58Z(cbj8i&~&9vZ=3TQAle&fQ~6>^$? zYz{<5K@EIUQXS^Nh%d6yoN{Ab3G)E|bd)^GD4a+=)d z9+aJG$lCl@D_mo^IL4y;wPQGJF1vAiHDnvmH)FU=%i@HbEPOV7hK}KClq_R7C7Vty zvY!9s`hi*{%NWj*b@u~&f2PhDuN}k1s<-e1l;vX5*Jj6Xv6_5-09WIyl-_?h@tgPO zA8GrYj>5Uok3LK-I9$hV-p6UR>ld?m;v|=xA65ivQLY{&?nZ4TmH4XlCwCh zsa0Ao>^yfrjth)8Q0uojtbWTFj`}%~TGr+;WQ;|A?+jY3V(jsNi181SS!p>hnQOKO z6))i$N(ak~|8Ig5ds+X>f~ZXA2X7abzt>@R 0 Then - MsgBox ("function call error:" & vbCrLf & wr) - Exit Sub - End If - - On Error GoTo errh - - Sheets("test").range("A2:D1000").ClearContents - Sheets("test").range("N3:Q14").ClearContents - - For i = 1 To json("jsonb_agg").Count - Sheets("test").Cells(i + 1, 1) = json("jsonb_agg")(i)("oseas") - Sheets("test").Cells(i + 1, 2) = json("jsonb_agg")(i)("monthn") - Sheets("test").Cells(i + 1, 3) = json("jsonb_agg")(i)("qty") - Sheets("test").Cells(i + 1, 4) = json("jsonb_agg")(i)("sales") - Next i - - Sheets("test").Select - -errh: - If Err.Number <> 0 Then - MsgBox (Err.Description) - End If - -End Sub - -Function scenario_totals(doc As String) As Object +Function request_adjust(doc As String) As Object Dim req As New WinHttp.WinHttpRequest Dim json As Object Dim wr As String With req - '.Open "GET", "http://10.56.1.15:3000/get_pool", True - .Open "GET", "http://localhost:3000/scenario_totals", True + '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True + '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True + .Open "GET", "http://localhost:3000/request_adjust", True .SetRequestHeader "Content-Type", "application/json" .Send doc .WaitForResponse @@ -153,7 +82,71 @@ Function scenario_totals(doc As String) As Object End Function -Sub pg_main_workset() + + +Function scenario_totals(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 + '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True + .Open "GET", "http://10.56.1.15:3000/scenario_totals", True + '.Open "GET", "http://localhost:3000/scenario_totals", True + .SetRequestHeader "Content-Type", "application/json" + .Send doc + .WaitForResponse + wr = .ResponseText + End With + + Set json = JsonConverter.ParseJson(wr) + Set scenario_totals = json + +errh: + If Err.Number <> 0 Then + status = False + MsgBox (Err.Description) + Set scenario_totals = Nothing + Else + status = True + End If + +End Function + +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 + .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 @@ -165,11 +158,10 @@ Sub pg_main_workset() Dim res() As Variant Dim str() As String - doc = "{""quota_rep"":""90005 - MARK WILKINSON""}" + doc = "{""quota_rep"":""" & rep & """}" With req - '.Open "GET", "http://10.56.1.15:3000/get_pool", True - .Open "GET", "http://192.168.1.69:3000/get_pool", True + .Open "GET", server & "/get_pool", True .SetRequestHeader "Content-Type", "application/json" .Send doc .WaitForResponse @@ -179,7 +171,7 @@ Sub pg_main_workset() Set json = JsonConverter.ParseJson(wr) ReDim res(json("x").Count, 32) - For i = 1 To UBound(res, 1) - 1 + 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") @@ -267,3 +259,33 @@ Sub pg_main_workset() Call x.SHTp_Dump(str, "data", 1, 1, True, False, 28, 29, 30, 31, 32) End Sub + +Sub pull_rep() + + openf.Show + +End Sub + +Sub test() + + Dim req As New WinHttp.WinHttpRequest + Dim json As Object + Dim wr As String + + + + With req + '.Open "GET", "http://10.56.1.15:3000/scenario_totals", True + '.Open "GET", "http://10.56.1.15:3000/scenario_package", True + .Open "GET", "http://localhost:3000/scenario_package", True + .SetRequestHeader "Content-Type", "application/json" + .Send handler.scenario + .WaitForResponse + wr = .ResponseText + End With + + Set json = JsonConverter.ParseJson(wr) + 'Set scenario_totals = json + + +End Sub diff --git a/pivot.bas b/pivot.bas index 86bf9ae..9d0472e 100644 --- a/pivot.bas +++ b/pivot.bas @@ -1,8 +1,8 @@ Option Explicit -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("b11:v100000")) Is Nothing Then + If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then Exit Sub End If @@ -11,7 +11,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean If Target.Cells.PivotTable Is Nothing Then Exit Sub End If - Cancel = True @@ -31,9 +30,6 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean 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 @@ -55,44 +51,13 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As range, Cancel As Boolean 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 - 'the following looks for filtered items, but this is redundant because a single one has been isolated - 'For Each pi In pt.PivotFields(piv_fld_index(rd(i).Name, pt)).PivotItems - ' If Not pi.Visible Then - ' sql = sql & vbCrLf & "AND " & rd(i).Name & " <> '" & pi.Name & "'" - ' End If - 'Next pi Next i - 'this block loops through items selected in colums, which will be ignored for now - 'For i = 1 To ci.Count - ' sql = sql & vbCrLf & "AND " - ' sql = sql & cd(piv_pos(cd, ci(i).Parent.Position)).Name & " = '" & ci(i).Name & "'" - 'Next i - - 'this loop iterates through every pivot field (even if not in the PT) and determines filtered items - 'For Each pf In Target.Cells.PivotTable.PivotFields - ' For Each pi In pf.PivotItems - ' If Not pi.Visible Then - ' sql = sql & vbCrLf & "AND " & pf.Name & " <> '" & pi.Name & "'" - ' End If - ' Next pi - 'Next pf - scenario = "{" & handler.jsql & "}" - 'Sheets("test").Cells(1, 14) = handler.jsql Call handler.load_fpvt - 'Call http.pull_months(scenario) - - 'jsql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE j @> '{" & jsql & "}'::jsonb" - 'sql = "SELECT count(*) FROM rlarp.osm_ppfa_varto_jmv WHERE " & sql - - 'MsgBox (sql) - - 'Call wapi.ClipBoard_SetData(sql) - nopiv: End Sub @@ -126,3 +91,5 @@ End Function + +