diff --git a/fpvt.frm b/fpvt.frm index 462a11e..6fb4aa8 100644 --- a/fpvt.frm +++ b/fpvt.frm @@ -4,7 +4,7 @@ Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt ClientHeight = 7260 ClientLeft = 120 ClientTop = 465 - ClientWidth = 16140 + ClientWidth = 17475 OleObjectBlob = "fpvt.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -101,6 +101,7 @@ End Sub Private Sub cbGoSheet_Click() Me.Hide + Worksheets("month").Visible = xlSheetVisible Sheets("month").Select End Sub @@ -328,8 +329,16 @@ Private Sub UserForm_Activate() fVol = bVol + pVol fVal = bVal + pVal - fPrc = fVal / fVol - pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol + If fVol = 0 Then + fPrc = 0 + Else + fPrc = fVal / fVol + End If + If (bVol + pVol) = 0 Then + pPrc = 0 + Else + pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol + End If Me.load_mbox_ann '---------------------------------------populate monthly------------------------------------------------------- diff --git a/fpvt.frx b/fpvt.frx index 65e763b..e85ac68 100644 Binary files a/fpvt.frx and b/fpvt.frx differ diff --git a/handler.bas b/handler.bas index 2c7fc79..5fd16a2 100644 --- a/handler.bas +++ b/handler.bas @@ -89,6 +89,7 @@ Sub pg_main_workset(rep As String) doc = "{""quota_rep"":""" & rep & """}" With req + .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All .Open "GET", handler.server & "/get_pool", True .SetRequestHeader "Content-Type", "application/json" .Send doc @@ -207,6 +208,7 @@ Function request_adjust(doc As String) As Object Dim str() As String Set json = JsonConverter.ParseJson(doc) + server = Sheets("config").Cells(1, 2) With req .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All @@ -389,7 +391,11 @@ Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant) If co_num(pkg(i, 3), 0) = 0 Then sh.Cells(i + 1, 8) = 0 Else - sh.Cells(i + 1, 8) = pkg(i, 7) / pkg(i, 3) - pkg(i, 6) / pkg(i, 2) + If (pkg(i, 3) + pkg(i, 2)) = 0 Then + sh.Cells(i + 1, 8) = 0 + Else + sh.Cells(i + 1, 8) = (pkg(i, 7) + pkg(i, 6)) / (pkg(i, 3) + pkg(i, 2)) - (pkg(i, 6) / pkg(i, 2)) + End If End If '--current adjust-- diff --git a/months.cls b/months.cls index e924f75..41ad231 100644 --- a/months.cls +++ b/months.cls @@ -29,12 +29,12 @@ Private showbasket As Boolean -Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean) +Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim i As Long Dim b() As Variant - cancel = True + Cancel = True If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then build.part = Sheets("month").Cells(Target.row, 2) build.bill = rev_cust(Sheets("month").Cells(Target.row, 6)) @@ -56,10 +56,10 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean Sheets("month").Cells(Target.row + i, 2) = build.cbPart.value Sheets("month").Cells(Target.row + i, 6) = rev_cust(build.cbBill.value) Sheets("month").Cells(Target.row + i, 12) = rev_cust(build.cbShip.value) - 'Sheets("month").Cells.Rows(Target.row + i).Select dumping = False Set basket_touch = Selection Call Me.get_edit_basket + Target.Select End If @@ -77,6 +77,44 @@ Public Function rev_cust(cust As String) As String End Function +Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) + + Dim i As Long + Dim b() As Variant + + Cancel = True + If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then + build.part = Sheets("month").Cells(Target.row, 2) + build.bill = rev_cust(Sheets("month").Cells(Target.row, 6)) + build.ship = rev_cust(Sheets("month").Cells(Target.row, 12)) + build.useval = False + build.Show + + If build.useval Then + dumping = True + 'if an empty row is selected, force it to be the next open slot + If Sheets("month").Cells(Target.row, 2) = "" Then + Do Until Sheets("month").Cells(Target.row + i, 2) <> "" + i = i - 1 + Loop + i = i + 1 + End If + + + Sheets("month").Cells(Target.row + i, 2) = build.cbPart.value + Sheets("month").Cells(Target.row + i, 6) = rev_cust(build.cbBill.value) + Sheets("month").Cells(Target.row + i, 12) = rev_cust(build.cbShip.value) + dumping = False + Set basket_touch = Selection + Call Me.get_edit_basket + Target.Select + + End If + + End If + +End Sub + Private Sub Worksheet_Change(ByVal Target As Range) @@ -100,6 +138,8 @@ Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("L6:L17")) Is Nothing Then Call Me.mvp_set If Not Intersect(Target, Range("Q6:Q17")) Is Nothing Then Call Me.ms_adj If Not Intersect(Target, Range("R6:R17")) Is Nothing Then Call Me.ms_set + + If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then Set basket_touch = Target Call Me.get_edit_basket @@ -166,6 +206,8 @@ End Sub Sub ms_set() +On Error GoTo errh + Dim i As Integer Call Me.get_sheet Dim vp As String @@ -173,7 +215,7 @@ Sub ms_set() For i = 1 To 12 If sales(i, 5) = "" Then sales(i, 5) = 0 - If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 6) <> Round(sales(i, 4), 6) Then + If Round(sales(i, 5) - (sales(i, 2) + sales(i, 3)), 2) <> Round(sales(i, 4), 2) Then sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3)) Select Case vp Case "volume" @@ -213,6 +255,9 @@ Sub ms_set() Me.crunch_array Me.set_sheet + +errh: + If Err.Number <> 0 Then rollback = True End Sub @@ -282,7 +327,7 @@ Sub get_sheet() tprice = Range("H18:L18") tsales = Range("N18:R18") ReDim adjust(12) - Set basejson = JsonConverter.ParseJson("{""scenario"":" & Sheets("_month").Range("P1").FormulaR1C1 & "}") + Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1) End Sub @@ -455,6 +500,19 @@ End Sub Sub build_json(ByVal pos As Integer) + Dim i As Long + Dim j As Long + + ReDim handler.basis(100) + i = 2 + j = 0 + Do While Sheets("config").Cells(2, i) <> "" + handler.basis(j) = Sheets("config").Cells(2, i) + j = j + 1 + i = i + 1 + Loop + ReDim Preserve handler.basis(j - 1) + 'if something is changing If Round(units(pos, 4), 2) <> 0 Or (Round(price(pos, 4), 8) <> 0 And Round(units(pos, 5), 2) <> 0) Then Set adjust(pos) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson)) @@ -468,13 +526,17 @@ Sub build_json(ByVal pos As Integer) 'if the target price is the same as average and a month is being added adjust(pos)("type") = "addmonth_v" End If + adjust(pos)("month") = Worksheets("month").Cells(5 + pos, 1) adjust(pos)("qty") = units(pos, 4) adjust(pos)("amount") = sales(pos, 4) Else 'scale the existing volume(price) on the target month If Round(price(pos, 4), 8) <> 0 Then - 'if the target price is diferent from the average and a month is being added - adjust(pos)("type") = "scale_vp" + If Round(units(pos, 4), 2) <> 0 Then + adjust(pos)("type") = "scale_vp" + Else + adjust(pos)("type") = "scale_p" + End If Else 'if the target price is the same as average and a month is being added adjust(pos)("type") = "scale_v" @@ -482,6 +544,11 @@ Sub build_json(ByVal pos As Integer) adjust(pos)("qty") = units(pos, 4) adjust(pos)("amount") = sales(pos, 4) End If + adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") + adjust(pos)("user") = Application.UserName + adjust(pos)("scenario")("version") = "b20" + adjust(pos)("scenario")("iter") = handler.basis + adjust(pos)("source") = "adj" End If End Sub @@ -515,14 +582,18 @@ Sub crunch_array() tprice(1, 5) = 0 End If 'adjust - tprice(1, 3) = (tsales(1, 2) + tsales(1, 3)) / (tunits(1, 2) + tunits(1, 3)) - tprice(1, 2) + If (tunits(1, 2) + tunits(1, 3)) = 0 Then + tprice(1, 3) = 0 + Else + tprice(1, 3) = (tsales(1, 2) + tsales(1, 3)) / (tunits(1, 2) + tunits(1, 3)) - tprice(1, 2) + End If 'current adjust tprice(1, 4) = tprice(1, 5) - (tprice(1, 2) + tprice(1, 3)) End Sub -Sub cancel() +Sub Cancel() Sheets("Orders").Select @@ -531,7 +602,11 @@ End Sub Sub reset() Call Me.load_sheet - + If showbasket Then + showbasket = False + Else + showbasket = True + End If End Sub @@ -654,9 +729,25 @@ Sub get_edit_basket() Worksheets("_month").Range("U2:X5000").ClearContents Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True) + 'orig.Select End Sub + +Sub post_adjust() + + Dim i As Long + + For i = 2 To 13 + If Sheets("_month").Cells(i, 16) <> "" Then + Call handler.request_adjust(Sheets("_month").Cells(i, 16)) + End If + Next i + + Sheets("Orders").Select + Worksheets("month").Visible = xlHidden + +End Sub