fix basket bugs

This commit is contained in:
Trowbridge 2019-03-19 16:46:56 -04:00
parent a3d9512373
commit dc6df26eba
4 changed files with 44 additions and 12 deletions

BIN
build.frx

Binary file not shown.

BIN
fpvt.frx

Binary file not shown.

View File

@ -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--

View File

@ -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)