build price list functionality
This commit is contained in:
pt
parent
787c2c736f
commit
4311b3b3e4
242
FL.bas
242
FL.bas
@ -1,5 +1,6 @@
|
||||
Option Explicit
|
||||
|
||||
Public price_sheet As Worksheet
|
||||
|
||||
Public x As New TheBigOne
|
||||
|
||||
@ -253,6 +254,7 @@ Function json_from_list(keys As range, values As range) As String
|
||||
Dim i As Integer
|
||||
Dim first_comma As Boolean
|
||||
Dim needs_braces As Integer
|
||||
Dim needs_comma As Boolean
|
||||
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
@ -276,6 +278,12 @@ Function json_from_list(keys As range, values As range) As String
|
||||
|
||||
End Function
|
||||
|
||||
Function json_nest(key As String, json As String) As String
|
||||
|
||||
json_nest = "{""" & key & """:" & json & "}"
|
||||
|
||||
End Function
|
||||
|
||||
Function json_concat(list As range) As String
|
||||
|
||||
Dim json As String
|
||||
@ -306,6 +314,7 @@ Sub json_from_table_pretty()
|
||||
Dim x As New TheBigOne
|
||||
Dim tbl() As Variant
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
tbl = Selection
|
||||
|
||||
Dim ajson As String
|
||||
@ -357,6 +366,7 @@ Sub json_from_table()
|
||||
|
||||
Dim tbl() As Variant
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
tbl = Selection
|
||||
|
||||
Call wapi.ClipBoard_SetData(x.json_from_table(tbl, "y", False))
|
||||
@ -555,6 +565,7 @@ Sub markdown_from_table()
|
||||
Dim wapi As New Windows_API
|
||||
Dim tbl() As Variant
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
tbl = Selection
|
||||
|
||||
Call wapi.ClipBoard_SetData(x.markdown_from_table(tbl))
|
||||
@ -589,7 +600,7 @@ Sub sql_from_range()
|
||||
Dim x As New TheBigOne
|
||||
Dim wapi As New Windows_API
|
||||
Dim r() As String
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2))
|
||||
|
||||
End Sub
|
||||
@ -672,4 +683,233 @@ Sub split_forecast_data()
|
||||
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Function range_empty(ByRef r As range) As Boolean
|
||||
|
||||
Dim c As range
|
||||
range_empty = True
|
||||
|
||||
For Each c In r.Cells
|
||||
If Not IsEmpty(c.value) Then
|
||||
range_empty = False
|
||||
Exit Function
|
||||
End If
|
||||
Next c
|
||||
|
||||
End Function
|
||||
|
||||
Function build_monthly(ByRef part As String, billto_group As String, month As String, vol As Double, amt As Double) As String
|
||||
|
||||
Dim j As Object
|
||||
|
||||
Set j("part") = part
|
||||
Set j("billto_group") = billto_group
|
||||
Set j("month") = month
|
||||
Set j("part") = vol
|
||||
Set j("part") = amt
|
||||
|
||||
build_monthly = JsonConverter.ConvertToJson(j)
|
||||
|
||||
End Function
|
||||
|
||||
Sub extract_price_matrix()
|
||||
|
||||
'------------------------------------setup-------------------------------------------------
|
||||
|
||||
Dim wapi As New Windows_API
|
||||
Dim x As New TheBigOne
|
||||
Dim tbl() As Variant
|
||||
Dim unp() As String
|
||||
Dim unps() As String
|
||||
Dim sql As String
|
||||
Dim error As String
|
||||
Dim orig As range
|
||||
Dim cms_pl() As String
|
||||
Dim pw As String
|
||||
Dim new_sh As Worksheet
|
||||
Dim ws As Worksheet
|
||||
Dim cp As CustomProperty
|
||||
|
||||
'------------------------------------selection-------------------------------------------------
|
||||
|
||||
Set orig = Application.Selection
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
|
||||
Set orig = Application.Selection
|
||||
|
||||
'--------------------------------test if valid price matrix------------------------------
|
||||
|
||||
If Selection.Cells.Count = 1 Then
|
||||
MsgBox ("selection is not a table")
|
||||
orig.Select
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
tbl = Selection
|
||||
|
||||
If UBound(tbl, 1) < 4 Then error = "selection is not a valid price matrix"
|
||||
If UBound(tbl, 2) < 2 Then error = "selection is not a valid price matrix"
|
||||
If Not error = "" Then
|
||||
MsgBox (error)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'-----------------------------unpivot price matrix into new array-----------------------------
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim k As Long
|
||||
k = 0
|
||||
ReDim unp(7, (UBound(tbl, 2) - 1) * (UBound(tbl, 1) - 3))
|
||||
For i = 4 To UBound(tbl, 1)
|
||||
For j = 2 To UBound(tbl, 2)
|
||||
k = k + 1
|
||||
'part
|
||||
unp(0, k) = tbl(i, 1)
|
||||
'copy headers down the left
|
||||
unp(1, k) = tbl(1, j) 'size code (row one, column j)
|
||||
unp(2, k) = tbl(2, j) 'volue break uom (row 2, column j)
|
||||
unp(3, k) = Format(tbl(3, j), "#.00") 'volue break qty (row 3, column j)
|
||||
unp(4, k) = "M" 'pricing unit of measuer
|
||||
unp(5, k) = Format(tbl(i, j), "#.00") 'price (row i, column j)
|
||||
unp(6, k) = i
|
||||
unp(7, k) = j
|
||||
Next j
|
||||
Next i
|
||||
unp(0, 0) = "mold"
|
||||
unp(1, 0) = "sizc"
|
||||
unp(2, 0) = "vbuom"
|
||||
unp(3, 0) = "vbqty"
|
||||
unp(4, 0) = "puom"
|
||||
unp(5, 0) = "price"
|
||||
unp(6, 0) = "orig_row"
|
||||
unp(7, 0) = "orig_col"
|
||||
|
||||
|
||||
'-------------------------prepare sql to upload---------------------------------------------------------------
|
||||
|
||||
sql = x.SQLp_build_sql_values(unp, False, True, Db2)
|
||||
sql = "DECLARE GLOBAL TEMPORARY TABLE session.plbuild AS (" & sql & ") WITH DATA"
|
||||
Call wapi.ClipBoard_SetData(sql)
|
||||
|
||||
login.Show
|
||||
If Not login.proceed Then Exit Sub
|
||||
|
||||
|
||||
If Not x.ADOp_OpenCon(0, ISeries, "S7830956", False, login.tbU.Text, login.tbP.Text) Then
|
||||
MsgBox ("not able to connect to CMS" & vbCrLf & x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Not x.ADOp_Exec(0, sql) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Call x.ADOp_CloseCon(0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'-------------------call price build procedure--------------------------------------------------------
|
||||
|
||||
cms_pl = x.ADOp_SelectS(0, "CALL rlarp.build_pricelist", True, 25000, True)
|
||||
|
||||
Call x.ADOp_CloseCon(0)
|
||||
|
||||
If x.ADOo_errstring <> "" Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'--------------------------setup an output sheet if necessary-------------------------------
|
||||
|
||||
For Each ws In Application.Worksheets
|
||||
For Each cp In ws.CustomProperties
|
||||
If cp.Name = "spec_name" And cp.value = "price_list" Then
|
||||
Set new_sh = ws
|
||||
End If
|
||||
Next cp
|
||||
Next ws
|
||||
|
||||
If new_sh Is Nothing Then
|
||||
Set new_sh = Application.Worksheets.Add
|
||||
Call new_sh.CustomProperties.Add("spec_name", "price_list")
|
||||
End If
|
||||
|
||||
'-------------------------dump contents------------------------------------------------------
|
||||
|
||||
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
||||
new_sh.Select
|
||||
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
||||
Selection.Columns.AutoFit
|
||||
|
||||
Rows("1:1").Select
|
||||
With ActiveWindow
|
||||
.SplitColumn = 0
|
||||
.SplitRow = 1
|
||||
End With
|
||||
ActiveWindow.FreezePanes = True
|
||||
|
||||
|
||||
'--------------------------format source cells for any build issues--------------------------------
|
||||
|
||||
orig.Worksheet.Select
|
||||
|
||||
With orig.Interior
|
||||
.Pattern = xlNone
|
||||
.TintAndShade = 0
|
||||
.PatternTintAndShade = 0
|
||||
End With
|
||||
|
||||
For i = 1 To UBound(cms_pl, 1)
|
||||
Select Case cms_pl(i, 9)
|
||||
Case ""
|
||||
Case "no unit conversion"
|
||||
orig.Worksheet.Cells(orig.row + cms_pl(i, 10) - 1, orig.column + cms_pl(i, 11) - 1).Interior.Color = RGB(255, 255, 161)
|
||||
Case "no part number"
|
||||
orig.Worksheet.Cells(orig.row + cms_pl(i, 10) - 1, orig.column + cms_pl(i, 11) - 1).Interior.Color = RGB(220, 220, 220)
|
||||
End Select
|
||||
Next i
|
||||
|
||||
'----------------------------cleanup-------------------------------------------------------------
|
||||
|
||||
Set x = Nothing
|
||||
|
||||
End Sub
|
||||
|
||||
Sub go_to_price_issue()
|
||||
|
||||
Dim ws As Worksheet
|
||||
Dim cp As CustomProperty
|
||||
Dim orig As range
|
||||
Dim trow As Long
|
||||
Dim tcol As Long
|
||||
Dim i As Long
|
||||
|
||||
For Each ws In Application.Worksheets
|
||||
For Each cp In ws.CustomProperties
|
||||
If cp.Name = "spec_name" And cp.value = "price_list" Then
|
||||
Set price_sheet = ws
|
||||
End If
|
||||
Next cp
|
||||
Next ws
|
||||
|
||||
Set orig = Application.Selection
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
|
||||
|
||||
trow = orig.row - Selection.row + 1
|
||||
tcol = orig.column - Selection.column + 1
|
||||
|
||||
i = 1
|
||||
Do Until price_sheet.Cells(i, 1) = ""
|
||||
If price_sheet.Cells(i, 11) = trow And price_sheet.Cells(i, 12) = tcol Then
|
||||
price_sheet.Select
|
||||
ActiveSheet.Cells(i, 10).Select
|
||||
Exit Sub
|
||||
End If
|
||||
i = i + 1
|
||||
Loop
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Loading…
Reference in New Issue
Block a user