diff --git a/build.frx b/build.frx index 7a922ea..1d32c5a 100644 Binary files a/build.frx and b/build.frx differ diff --git a/fpvt.frx b/fpvt.frx index d530870..65e763b 100644 Binary files a/fpvt.frx and b/fpvt.frx differ diff --git a/handler.bas b/handler.bas index b554499..2c7fc79 100644 --- a/handler.bas +++ b/handler.bas @@ -209,6 +209,7 @@ Function request_adjust(doc As String) As Object Set json = JsonConverter.ParseJson(doc) With req + .Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All .Open "POST", server & "/" & json("type"), True .SetRequestHeader "Content-Type", "application/json" .Send doc @@ -388,7 +389,7 @@ 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) + sh.Cells(i + 1, 8) = pkg(i, 7) / pkg(i, 3) - pkg(i, 6) / pkg(i, 2) End If '--current adjust-- diff --git a/months.cls b/months.cls index f962d79..e924f75 100644 --- a/months.cls +++ b/months.cls @@ -25,6 +25,7 @@ Private rollback As Boolean Private scenario() As Variant Private orig As Range Private basket_touch As Range +Private showbasket As Boolean @@ -36,8 +37,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean cancel = True If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then build.part = Sheets("month").Cells(Target.row, 2) - build.bill = Sheets("month").Cells(Target.row, 6) - build.ship = Sheets("month").Cells(Target.row, 12) + 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 @@ -51,9 +52,10 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean i = i + 1 End If + Sheets("month").Cells(Target.row + i, 2) = build.cbPart.value - Sheets("month").Cells(Target.row + i, 6) = build.cbBill.value - Sheets("month").Cells(Target.row + i, 12) = build.cbShip.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 @@ -65,6 +67,16 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean End Sub +Public Function rev_cust(cust As String) As String + + If InStr(1, cust, " - ") <= 9 Then + rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(left(cust, 8)) + Else + rev_cust = trim(right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - ")) + End If + +End Function + Private Sub Worksheet_Change(ByVal Target As Range) @@ -88,7 +100,7 @@ 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 + If Not Intersect(Target, Range("B33:Q1000")) Is Nothing Then Set basket_touch = Target Call Me.get_edit_basket End If @@ -287,7 +299,7 @@ Sub set_sheet() Range("H18:L18").FormulaR1C1 = tprice Range("N18:R18").FormulaR1C1 = tsales Range("T6:U18").ClearContents - Range("T6:U18").FormulaR1C1 = scenario + Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False) 'Sheets("month").Range("B32:Q5000").ClearContents @@ -295,9 +307,9 @@ Sub set_sheet() Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i)) Next i - ActiveWindow.FreezePanes = False - - Rows("19:32").Hidden = False + If showbasket Then + Call Me.show_basket + End If dumping = False @@ -525,6 +537,16 @@ End Sub Sub show_basket() + + If showbasket Then + showbasket = False + dumping = True + Worksheets("month").Range("B32:Q10000").ClearContents + dumping = False + Exit Sub + End If + showbasket = True + Dim i As Long Dim basket() As Variant basket = x.SHTp_get_block(Sheets("_month").Range("U1")) @@ -577,6 +599,7 @@ Sub get_edit_basket() Dim b() As Variant Dim mix As Double Dim touch_mix As Double + Dim untouched As Long Dim touch() As Boolean 'ReDim b(basket_rows, 3) @@ -589,6 +612,7 @@ Sub get_edit_basket() ReDim b(i, 3) ReDim touch(i) + untouched = i + 1 i = 0 mix = 0 @@ -602,6 +626,7 @@ Sub get_edit_basket() If Not Intersect(basket_touch, Worksheets("month").Cells(33 + i, 17)) Is Nothing Then touch_mix = touch_mix + b(i, 3) touch(i) = True + untouched = untouched - 1 End If i = i + 1 Loop @@ -609,7 +634,11 @@ Sub get_edit_basket() 'evaluate mix changes and force to 100 For i = 0 To UBound(b, 1) If Not touch(i) Then - b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix) + If mix - touch_mix = 0 Then + b(i, 3) = (1 - mix) / untouched + Else + b(i, 3) = b(i, 3) + b(i, 3) * (1 - mix) / (mix - touch_mix) + End If End If Next i @@ -623,7 +652,9 @@ Sub get_edit_basket() dumping = False Worksheets("_month").Range("U2:X5000").ClearContents - Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False) + Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True) + +