finalize to get 1.5 done

This commit is contained in:
pt 2020-03-13 17:31:48 -04:00
parent 7182502669
commit 64c7be2587
8 changed files with 116 additions and 7 deletions

View File

@ -67,9 +67,12 @@ Private Sub UserForm_Activate()
cbBill.value = bill cbBill.value = bill
cbShip.value = ship cbShip.value = ship
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267")) cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A2").CurrentRegion)
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D14295")) 'cbPart.list(1).Remove
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D14295")) cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
'cbPart.list(1).Remove
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
'cbPart.list(1).Remove
End Sub End Sub

BIN
build.frx

Binary file not shown.

View File

@ -38,8 +38,6 @@ Private Sub lbHist_Change()
Exit Sub Exit Sub
End If End If
Next i Next i
End Sub End Sub

Binary file not shown.

112
fpvt.frm
View File

@ -24,11 +24,14 @@ Private load_tb As Boolean
Private set_Price As Boolean Private set_Price As Boolean
Private sp As Object Private sp As Object
Private basket() As Variant Private basket() As Variant
Private cust() As Variant
Private vSwap() As Variant Private vSwap() As Variant
Private swapline As Integer Private swapline As Integer
Private set_swapalt As Boolean Private set_swapalt As Boolean
Private return_swap As Boolean Private return_swap As Boolean
Private jswap As Object Private jswap As Object
Private cswap As Object
Private cust_s() As Boolean
Private bVol As Double Private bVol As Double
Private bVal As Double Private bVal As Double
@ -169,7 +172,6 @@ Private Sub cbTAG_Change()
End Sub End Sub
Private Sub lbMonth_Change() Private Sub lbMonth_Change()
If clear_lb Or load_tb Then Exit Sub If clear_lb Or load_tb Then Exit Sub
@ -738,6 +740,20 @@ Private Sub UserForm_Activate()
basket(i, 3) = sp("package")("basket")(i)("mix") basket(i, 3) = sp("package")("basket")(i)("mix")
Next i Next i
'---------------get list of customers----------------------------
ReDim cust(sp("package")("customers").Count - 1, 3)
For i = 0 To UBound(cust, 1)
cust(i, 0) = sp("package")("customers")(i + 1)("bill_cust_descr")
cust(i, 1) = ""
cust(i, 2) = sp("package")("customers")(i + 1)("ship_cust_descr")
cust(i, 3) = ""
Next i
Call x.frmListBoxHeader(lbCUSTH, lbCUST, "Bill-To", "Replace", "Ship-To", "Replace")
'-------------load tags------------------------------- '-------------load tags-------------------------------
If Not IsNull(sp("package")("tags")) Then If Not IsNull(sp("package")("tags")) Then
@ -760,7 +776,10 @@ Private Sub UserForm_Activate()
lbSWAP.clear lbSWAP.clear
pickSWAP.value = "" pickSWAP.value = ""
pickSWAP.text = Mid(sp("package")("basket")(1)("part_descr"), 1, 8) pickSWAP.text = Mid(sp("package")("basket")(1)("part_descr"), 1, 8)
pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F1112")) pickSWAP.list = Application.transpose(Worksheets("mdata").Range("F2:F2").CurrentRegion)
cbBT.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
cbST.list = Application.transpose(Worksheets("mdata").Range("D2:D2").CurrentRegion)
lbCUST.list = cust
Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit") Call x.frmListBoxHeader(Me.lbSWAPH, Me.lbSWAP, "Original", "Sales", "Replacement", "Fit")
'---------price volume radio button colors---------- '---------price volume radio button colors----------
@ -824,6 +843,95 @@ Sub crunch_array()
End Sub End Sub
Private Sub lbCUST_Change()
Dim i As Long
Dim x() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then Exit For
Next i
cbBT.text = x(i, 0)
cbST.text = x(i, 2)
End Sub
Private Sub cbBT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
Dim x() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then x(i, 1) = Me.rev_cust(cbBT.text)
Next i
lbCUST.list = x
Call Me.build_cust_swap
End Sub
Private Sub cbST_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub
Dim i As Long
Dim x() As Variant
x = lbCUST.list
For i = 0 To UBound(x, 1)
If lbCUST.Selected(i) Then x(i, 3) = Me.rev_cust(cbST.text)
Next i
lbCUST.list = x
Call Me.build_cust_swap
End Sub
Sub build_cust_swap()
Dim vtable() As Variant
Dim ptable As String
vtable = lbCUST.list
vtable = x.ARRAYp_TransposeVar(vtable)
vtable = x.ARRAYp_zerobased_addheader(vtable, "bill", "bill_r", "ship", "ship_r")
vtable = x.ARRAYp_TransposeVar(vtable)
ptable = x.json_from_table_zb(vtable, "rows", True, False)
Set cswap = JsonConverter.ParseJson("{""scenario"":" & handler.scenario & "}")
cswap("scenario")("version") = handler.plan
cswap("scenario")("iter") = handler.basis
cswap("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
cswap("user") = Application.UserName
cswap("source") = "adj"
cswap("message") = tbCOM.text
cswap("tag") = cbTAG.text
cswap("type") = "cust_swap"
Set cswap("swap") = JsonConverter.ParseJson(ptable)
tbAPI.text = JsonConverter.ConvertToJson(cswap)
End Sub
Public Function rev_cust(cust As String) As String
If cust = "" Then
rev_cust = ""
Exit Function
End If
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
Sub load_var() Sub load_var()
'base 'base

BIN
fpvt.frx

Binary file not shown.

BIN
openf.frx

Binary file not shown.

BIN
part.frx

Binary file not shown.