Compare commits
73 Commits
f546f7c7d1
...
4b6d0c744d
Author | SHA1 | Date | |
---|---|---|---|
|
4b6d0c744d | ||
|
99905a9341 | ||
|
022240f8d3 | ||
|
b4291d15e7 | ||
|
79e3c24a37 | ||
|
35f5b04a1d | ||
|
56bb03ce7d | ||
|
aa88dbc9e7 | ||
|
f825c61b62 | ||
|
733d65881e | ||
|
94bc6e2b14 | ||
|
07d66cc754 | ||
|
9b14ba77f5 | ||
|
fdd3ce6d93 | ||
|
4311b3b3e4 | ||
|
787c2c736f | ||
|
08a64f4592 | ||
|
111121a801 | ||
|
c38e262733 | ||
|
830894ed5d | ||
|
1a09f55fb9 | ||
|
6a5782035a | ||
|
d4daa4e460 | ||
|
0be91dd6f8 | ||
|
7d0ff997c1 | ||
|
513e6e91b7 | ||
|
70326aa1fb | ||
|
f6207d0586 | ||
|
c9fff3e27e | ||
|
5a87acc876 | ||
|
90caea49f6 | ||
|
c5f28a081b | ||
|
7d2e018388 | ||
|
ae5515a83e | ||
|
f5a60c7b7c | ||
|
ddbc3d0fd2 | ||
|
cf36de40b4 | ||
|
f9d5aaf782 | ||
|
dc6df26eba | ||
|
a3d9512373 | ||
|
6a34f3fcf4 | ||
|
9b8a486981 | ||
|
e7071a777c | ||
|
d2a9549e77 | ||
|
64cb03a975 | ||
|
5dce331355 | ||
|
a444e3a08b | ||
|
4c73ab5f5c | ||
|
75af4275f2 | ||
|
67ac7d9cff | ||
|
2f56c991a7 | ||
|
e3bf5bdcf5 | ||
|
019c83c34f | ||
|
7f3f858744 | ||
|
42fad8ab1a | ||
|
6794d8ff9a | ||
|
3447f9d48c | ||
|
bbf3d84e60 | ||
|
856c885c44 | ||
|
6ad0c69c33 | ||
|
699d0fbb2e | ||
|
93a5086160 | ||
|
ba99264fb6 | ||
|
85c3269bcc | ||
|
678c0cafc9 | ||
|
878e691a55 | ||
|
5a2dfcdf27 | ||
|
953bd3548f | ||
|
46f834a985 | ||
|
77aa3c3366 | ||
|
cc7a4a7e08 | ||
|
0da2984907 | ||
|
144c0f85db |
414
FL.bas
414
FL.bas
@ -1,17 +1,30 @@
|
|||||||
|
Attribute VB_Name = "FL"
|
||||||
Option Explicit
|
Option Explicit
|
||||||
|
|
||||||
|
Public price_sheet As Worksheet
|
||||||
Public x As New TheBigOne
|
Public x As New TheBigOne
|
||||||
|
Public Enum ColorTier
|
||||||
|
B_ase = 0
|
||||||
|
T_raditional = 1
|
||||||
|
principa_L = 2
|
||||||
|
pre_M_ium = 3
|
||||||
|
P_rogram = 4
|
||||||
|
C_ustom = 5
|
||||||
|
E_cogrow = 6
|
||||||
|
O_rganic = 7
|
||||||
|
W_axtough = 8
|
||||||
|
End Enum
|
||||||
|
|
||||||
|
|
||||||
Sub Determine_Active_Range()
|
Sub Determine_Active_Range()
|
||||||
|
|
||||||
Dim r As range
|
Dim r As Range
|
||||||
Dim s As String
|
Dim s As String
|
||||||
Dim cell As range
|
Dim cell As Range
|
||||||
|
|
||||||
Set r = Selection
|
Set r = Selection
|
||||||
|
|
||||||
MsgBox (r.Address)
|
MsgBox (r.address)
|
||||||
|
|
||||||
For Each cell In r.Cells
|
For Each cell In r.Cells
|
||||||
s = s & cell.value
|
s = s & cell.value
|
||||||
@ -24,8 +37,8 @@ End Sub
|
|||||||
Sub Cross_Join_Selection()
|
Sub Cross_Join_Selection()
|
||||||
|
|
||||||
Dim x As New TheBigOne
|
Dim x As New TheBigOne
|
||||||
Dim r As range
|
Dim r As Range
|
||||||
Dim ar As range
|
Dim ar As Range
|
||||||
Dim r1() As String
|
Dim r1() As String
|
||||||
Dim r2() As String
|
Dim r2() As String
|
||||||
Dim d() As String
|
Dim d() As String
|
||||||
@ -236,7 +249,7 @@ End Function
|
|||||||
|
|
||||||
Sub add_quote_front()
|
Sub add_quote_front()
|
||||||
|
|
||||||
Dim r As range
|
Dim r As Range
|
||||||
Set r = Selection
|
Set r = Selection
|
||||||
Dim c As Object
|
Dim c As Object
|
||||||
|
|
||||||
@ -247,12 +260,13 @@ Sub add_quote_front()
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Function json_from_list(keys As range, values As range) As String
|
Function json_from_list(keys As Range, values As Range) As String
|
||||||
|
|
||||||
Dim json As String
|
Dim json As String
|
||||||
Dim i As Integer
|
Dim i As Integer
|
||||||
Dim first_comma As Boolean
|
Dim first_comma As Boolean
|
||||||
Dim needs_braces As Integer
|
Dim needs_braces As Integer
|
||||||
|
Dim needs_comma As Boolean
|
||||||
|
|
||||||
needs_comma = False
|
needs_comma = False
|
||||||
needs_braces = 0
|
needs_braces = 0
|
||||||
@ -276,7 +290,13 @@ Function json_from_list(keys As range, values As range) As String
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Function json_concat(list As range) As String
|
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
|
Dim json As String
|
||||||
Dim i As Integer
|
Dim i As Integer
|
||||||
@ -306,6 +326,7 @@ Sub json_from_table_pretty()
|
|||||||
Dim x As New TheBigOne
|
Dim x As New TheBigOne
|
||||||
Dim tbl() As Variant
|
Dim tbl() As Variant
|
||||||
|
|
||||||
|
Selection.CurrentRegion.Select
|
||||||
tbl = Selection
|
tbl = Selection
|
||||||
|
|
||||||
Dim ajson As String
|
Dim ajson As String
|
||||||
@ -357,6 +378,7 @@ Sub json_from_table()
|
|||||||
|
|
||||||
Dim tbl() As Variant
|
Dim tbl() As Variant
|
||||||
|
|
||||||
|
Selection.CurrentRegion.Select
|
||||||
tbl = Selection
|
tbl = Selection
|
||||||
|
|
||||||
Call wapi.ClipBoard_SetData(x.json_from_table(tbl, "y", False))
|
Call wapi.ClipBoard_SetData(x.json_from_table(tbl, "y", False))
|
||||||
@ -364,6 +386,7 @@ Sub json_from_table()
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub PastValues()
|
Sub PastValues()
|
||||||
|
Attribute PastValues.VB_ProcData.VB_Invoke_Func = "V\n14"
|
||||||
|
|
||||||
On Error GoTo errh
|
On Error GoTo errh
|
||||||
|
|
||||||
@ -375,6 +398,7 @@ errh:
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub CollapsePvtItem()
|
Sub CollapsePvtItem()
|
||||||
|
Attribute CollapsePvtItem.VB_ProcData.VB_Invoke_Func = "Z\n14"
|
||||||
|
|
||||||
On Error GoTo show_det
|
On Error GoTo show_det
|
||||||
ActiveCell.PivotItem.DrilledDown = False
|
ActiveCell.PivotItem.DrilledDown = False
|
||||||
@ -402,6 +426,7 @@ errh:
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub ExpandPvtItem()
|
Sub ExpandPvtItem()
|
||||||
|
Attribute ExpandPvtItem.VB_ProcData.VB_Invoke_Func = "X\n14"
|
||||||
|
|
||||||
On Error GoTo show_det
|
On Error GoTo show_det
|
||||||
ActiveCell.PivotItem.DrilledDown = True
|
ActiveCell.PivotItem.DrilledDown = True
|
||||||
@ -429,6 +454,7 @@ errh:
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub CollapsePvtFld()
|
Sub CollapsePvtFld()
|
||||||
|
Attribute CollapsePvtFld.VB_ProcData.VB_Invoke_Func = "A\n14"
|
||||||
|
|
||||||
On Error GoTo show_det
|
On Error GoTo show_det
|
||||||
ActiveCell.PivotField.DrilledDown = False
|
ActiveCell.PivotField.DrilledDown = False
|
||||||
@ -457,6 +483,7 @@ errh:
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub ExpandPvtFld()
|
Sub ExpandPvtFld()
|
||||||
|
Attribute ExpandPvtFld.VB_ProcData.VB_Invoke_Func = "S\n14"
|
||||||
|
|
||||||
On Error GoTo show_det
|
On Error GoTo show_det
|
||||||
ActiveCell.PivotField.DrilledDown = True
|
ActiveCell.PivotField.DrilledDown = True
|
||||||
@ -555,6 +582,7 @@ Sub markdown_from_table()
|
|||||||
Dim wapi As New Windows_API
|
Dim wapi As New Windows_API
|
||||||
Dim tbl() As Variant
|
Dim tbl() As Variant
|
||||||
|
|
||||||
|
Selection.CurrentRegion.Select
|
||||||
tbl = Selection
|
tbl = Selection
|
||||||
|
|
||||||
Call wapi.ClipBoard_SetData(x.markdown_from_table(tbl))
|
Call wapi.ClipBoard_SetData(x.markdown_from_table(tbl))
|
||||||
@ -584,13 +612,43 @@ Sub markdown_whole_sheet()
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
Sub sql_from_range()
|
Sub sql_from_range_db2_qh()
|
||||||
|
|
||||||
Dim x As New TheBigOne
|
Dim x As New TheBigOne
|
||||||
Dim wapi As New Windows_API
|
Dim wapi As New Windows_API
|
||||||
Dim r() As String
|
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, True))
|
||||||
|
|
||||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2))
|
End Sub
|
||||||
|
|
||||||
|
Sub sql_from_range_db2_noqh()
|
||||||
|
|
||||||
|
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, False))
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub sql_from_range_pg_qh()
|
||||||
|
|
||||||
|
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, PostgreSQL, True))
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub sql_from_range_pg_noqh()
|
||||||
|
|
||||||
|
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, PostgreSQL, False))
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
@ -601,6 +659,7 @@ Sub auto_fit_range()
|
|||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub pivot_field_format()
|
Sub pivot_field_format()
|
||||||
|
Attribute pivot_field_format.VB_ProcData.VB_Invoke_Func = "F\n14"
|
||||||
|
|
||||||
ActiveSheet.PivotTables(1).PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
ActiveSheet.PivotTables(1).PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||||
|
|
||||||
@ -672,4 +731,337 @@ 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(8, (UBound(tbl, 2) - 1) * (UBound(tbl, 1) - 4))
|
||||||
|
For i = 5 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) 'color code/tier (row one, column j)
|
||||||
|
unp(2, k) = tbl(2, j) 'size code (row two, column j)
|
||||||
|
unp(3, k) = tbl(3, j) 'volue break uom (row 3, column j)
|
||||||
|
unp(4, k) = Format(tbl(4, j), "#.00") 'volue break qty (row 4, column j)
|
||||||
|
unp(5, k) = "M" 'pricing unit of measuer
|
||||||
|
unp(6, k) = Format(tbl(i, j), "#.00") 'price (row i, column j)
|
||||||
|
unp(7, k) = i
|
||||||
|
unp(8, k) = j
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
unp(0, 0) = "mold"
|
||||||
|
unp(1, 0) = "sizc"
|
||||||
|
unp(2, 0) = "color"
|
||||||
|
unp(3, 0) = "vbuom"
|
||||||
|
unp(4, 0) = "vbqty"
|
||||||
|
unp(5, 0) = "puom"
|
||||||
|
unp(6, 0) = "price"
|
||||||
|
unp(7, 0) = "orig_row"
|
||||||
|
unp(8, 0) = "orig_col"
|
||||||
|
|
||||||
|
If Not x.TBLp_TestNumeric(unp, 4) Then
|
||||||
|
MsgBox ("volume break quantity is text")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not x.TBLp_TestNumeric(unp, 6) Then
|
||||||
|
MsgBox ("price is text")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
'-------------------------prepare sql to upload---------------------------------------------------------------
|
||||||
|
|
||||||
|
sql = x.SQLp_build_sql_values(unp, False, True, Db2, False)
|
||||||
|
sql = "DECLARE GLOBAL TEMPORARY TABLE session.plbuild AS (" & sql & ") WITH DATA"
|
||||||
|
Call wapi.ClipBoard_SetData(sql)
|
||||||
|
|
||||||
|
If MsgBox(sql, vbOKCancel, "continue with build?") = vbCancel Then Exit Sub
|
||||||
|
|
||||||
|
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, 13)
|
||||||
|
Case ""
|
||||||
|
Case "no unit conversion"
|
||||||
|
orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 1).Interior.Color = RGB(255, 255, 161)
|
||||||
|
Case "no part number"
|
||||||
|
orig.Worksheet.Cells(orig.row + cms_pl(i, 14) - 1, orig.column + cms_pl(i, 15) - 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
|
||||||
|
Dim has_Pricesheet As Boolean
|
||||||
|
|
||||||
|
has_Pricesheet = False
|
||||||
|
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
|
||||||
|
has_Pricesheet = True
|
||||||
|
End If
|
||||||
|
Next cp
|
||||||
|
Next ws
|
||||||
|
|
||||||
|
If Not has_Pricesheet Then
|
||||||
|
MsgBox ("no price sheet found")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Set orig = Application.Selection
|
||||||
|
|
||||||
|
Selection.CurrentRegion.Select
|
||||||
|
|
||||||
|
|
||||||
|
trow = orig.row - Selection.row + 1
|
||||||
|
tcol = orig.column - Selection.column + 1
|
||||||
|
|
||||||
|
orig.Select
|
||||||
|
|
||||||
|
i = 1
|
||||||
|
Do Until price_sheet.Cells(i, 1) = ""
|
||||||
|
If price_sheet.Cells(i, 15) = trow And price_sheet.Cells(i, 16) = tcol And price_sheet.Cells(i, 14) <> "" Then
|
||||||
|
price_sheet.Select
|
||||||
|
ActiveSheet.Cells(i, 14).Select
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub build_price_upload()
|
||||||
|
|
||||||
|
Dim x As New TheBigOne
|
||||||
|
Dim pl() As String
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim ul() As String
|
||||||
|
Dim pl_code As String
|
||||||
|
Dim pl_action As String
|
||||||
|
Dim pl_d1 As String
|
||||||
|
Dim pl_d2 As String
|
||||||
|
Dim pl_d3 As String
|
||||||
|
Dim fd As FileDialog
|
||||||
|
|
||||||
|
pl = x.SHTp_GetString(Selection)
|
||||||
|
ReDim ul(11, UBound(pl, 2))
|
||||||
|
|
||||||
|
PRICELIST_SHOW:
|
||||||
|
|
||||||
|
pricelist.Show
|
||||||
|
|
||||||
|
pl_code = pricelist.tbCODE.Text
|
||||||
|
pl_d1 = pricelist.tbD1.Text
|
||||||
|
pl_d2 = pricelist.tbD2.Text
|
||||||
|
pl_d3 = pricelist.tbD3.Text
|
||||||
|
pl_action = "1"
|
||||||
|
|
||||||
|
If Len(pricelist.tbCODE) > 5 Then
|
||||||
|
MsgBox ("price code must be 5 or less characters")
|
||||||
|
GoTo PRICELIST_SHOW
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not pricelist.cbInactive Then
|
||||||
|
Call x.TBLp_FilterSingle(pl, 11, "I", False)
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not pricelist.cbNonStocked Then
|
||||||
|
Call x.TBLp_FilterSingle(pl, 10, "A", True)
|
||||||
|
End If
|
||||||
|
|
||||||
|
|
||||||
|
ul(0, 0) = "HDR"
|
||||||
|
ul(1, 0) = pl_action
|
||||||
|
ul(2, 0) = pl_code
|
||||||
|
ul(3, 0) = Left(pl_d1, 30)
|
||||||
|
ul(4, 0) = Left(pl_d2, 30)
|
||||||
|
ul(5, 0) = Left(pl_d3, 30)
|
||||||
|
ul(6, 0) = "Y"
|
||||||
|
ul(7, 0) = "N"
|
||||||
|
j = 0
|
||||||
|
For i = LBound(pl, 2) + 1 To UBound(pl, 2)
|
||||||
|
'if there is no [uom, part#, price], don't create a row
|
||||||
|
If pl(12, i) <> "" And pl(13, i) <> "" And pl(8, i) <> "" And pl(9, i) <> "" Then
|
||||||
|
j = j + 1
|
||||||
|
ul(0, j) = "DTL" 'DTL
|
||||||
|
ul(1, j) = pl_code 'Price list code
|
||||||
|
ul(2, j) = pl(9, i) 'part number
|
||||||
|
ul(3, j) = pl(7, i) 'price unit
|
||||||
|
ul(4, j) = Format(CDbl(pl(6, i)) * CDbl(pl(12, i)) / CDbl(pl(13, i)), "0.00") 'volume break in price uom
|
||||||
|
ul(5, j) = Format(pl(8, i), "0.00") 'price
|
||||||
|
ul(11, j) = "1" 'add, update, delete
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
ReDim Preserve ul(11, j)
|
||||||
|
|
||||||
|
|
||||||
|
'--------Open file-------------
|
||||||
|
|
||||||
|
If Not x.FILEp_CreateCSV(pricelist.tbPATH.Text & "\" & pl_code & ".csv", ul) Then
|
||||||
|
MsgBox ("error")
|
||||||
|
End If
|
||||||
|
|
||||||
|
Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & pl_code & ".csv")
|
||||||
|
|
||||||
|
'---------------------header row---------------------------------
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
1125
JsonConverter.bas
Normal file
1125
JsonConverter.bas
Normal file
File diff suppressed because it is too large
Load Diff
312
TheBigOne.cls
312
TheBigOne.cls
@ -1,3 +1,13 @@
|
|||||||
|
VERSION 1.0 CLASS
|
||||||
|
BEGIN
|
||||||
|
MultiUse = -1 'True
|
||||||
|
END
|
||||||
|
Attribute VB_Name = "TheBigOne"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = False
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
|
||||||
Option Explicit
|
Option Explicit
|
||||||
|
|
||||||
Private ADOo_con() As ADODB.Connection
|
Private ADOo_con() As ADODB.Connection
|
||||||
@ -7,7 +17,7 @@ Public ADOo_errstring As String
|
|||||||
Public Enum ADOinterface
|
Public Enum ADOinterface
|
||||||
MicrosoftJetOLEDB4 = 0
|
MicrosoftJetOLEDB4 = 0
|
||||||
MicrosoftACEOLEDB12 = 1
|
MicrosoftACEOLEDB12 = 1
|
||||||
SQLServer = 2
|
SqlServer = 2
|
||||||
SQLServerNativeClient = 3
|
SQLServerNativeClient = 3
|
||||||
SQLServerNativeClient10 = 4
|
SQLServerNativeClient10 = 4
|
||||||
OracleODBC = 5
|
OracleODBC = 5
|
||||||
@ -19,11 +29,13 @@ End Enum
|
|||||||
|
|
||||||
Public Enum SQLsyntax
|
Public Enum SQLsyntax
|
||||||
Db2 = 0
|
Db2 = 0
|
||||||
SQLServer = 1
|
SqlServer = 1
|
||||||
PostgreSQL = 2
|
PostgreSQL = 2
|
||||||
End Enum
|
End Enum
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Public Function TBLp_Aggregate(ByRef tbl() As String, ByRef needsort As Boolean, ByRef headers As Boolean, ByRef del_unused As Boolean, ParamArray groupnum_type_sumnum()) As Boolean
|
Public Function TBLp_Aggregate(ByRef tbl() As String, ByRef needsort As Boolean, ByRef headers As Boolean, ByRef del_unused As Boolean, ParamArray groupnum_type_sumnum()) As Boolean
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
@ -387,7 +399,7 @@ Sub SHTp_Dump(ByRef tbl() As String, ByRef sheet As String, ByRef row As Long, B
|
|||||||
If clear Then sh.Cells.clear
|
If clear Then sh.Cells.clear
|
||||||
If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
||||||
|
|
||||||
sh.range(sh.Cells(row, col).Address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).Address).FormulaR1C1 = tbl
|
sh.Range(sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).address).FormulaR1C1 = tbl
|
||||||
|
|
||||||
On Error GoTo errhndl
|
On Error GoTo errhndl
|
||||||
|
|
||||||
@ -403,6 +415,30 @@ errhndl:
|
|||||||
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub SHTp_DumpVar(ByRef tbl() As Variant, ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef clear As Boolean, ByRef transpose As Boolean, ByRef zerobase As Boolean)
|
||||||
|
|
||||||
|
Dim sh As Worksheet
|
||||||
|
Dim address As String
|
||||||
|
Set sh = Sheets(sheet)
|
||||||
|
|
||||||
|
'If clear Then sh.Cells.clear
|
||||||
|
'If transpose Then Call Me.ARRAYp_Transpose(tbl)
|
||||||
|
If zerobase Then
|
||||||
|
address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).address
|
||||||
|
Else
|
||||||
|
address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1) - 1, col + UBound(tbl, 2) - 1).address
|
||||||
|
End If
|
||||||
|
sh.Range(address).FormulaR1C1 = tbl
|
||||||
|
|
||||||
|
On Error GoTo errhndl
|
||||||
|
|
||||||
|
|
||||||
|
errhndl:
|
||||||
|
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
||||||
|
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub ARRAYp_Transpose(ByRef a() As String)
|
Sub ARRAYp_Transpose(ByRef a() As String)
|
||||||
@ -464,19 +500,19 @@ errhdnl:
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Sub TBLp_FilterSingle(ByRef table() As String, ByRef column As Long, ByVal Filter As String, ByVal Equals As Boolean)
|
|
||||||
|
|
||||||
|
Public Sub TBLp_FilterSingle(ByRef table() As String, ByRef column As Long, ByVal Filter As String, ByVal Equals As Boolean)
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim j As Long
|
Dim j As Long
|
||||||
Dim m As Long
|
Dim m As Long
|
||||||
|
|
||||||
j = 0
|
j = LBound(table, 2)
|
||||||
i = 1
|
i = LBound(table, 2) + 1
|
||||||
While i <= UBound(table, 2)
|
While i <= UBound(table, 2)
|
||||||
If (table(column, i) = Filter) = Equals Then
|
If (table(column, i) = Filter) = Equals Then
|
||||||
j = j + 1
|
j = j + 1
|
||||||
m = 0
|
m = LBound(table, 1)
|
||||||
While m <= UBound(table, 1)
|
While m <= UBound(table, 1)
|
||||||
table(m, j) = table(m, i)
|
table(m, j) = table(m, i)
|
||||||
m = m + 1
|
m = m + 1
|
||||||
@ -485,7 +521,7 @@ Public Sub TBLp_FilterSingle(ByRef table() As String, ByRef column As Long, ByVa
|
|||||||
i = i + 1
|
i = i + 1
|
||||||
Wend
|
Wend
|
||||||
|
|
||||||
ReDim Preserve table(UBound(table, 1), j)
|
ReDim Preserve table(LBound(table, 1) To UBound(table, 1), LBound(table, 2) To j)
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
@ -545,21 +581,21 @@ Sub TBLp_DeleteCols(ByRef tbl() As String, ByRef column() As Integer)
|
|||||||
Dim j As Long
|
Dim j As Long
|
||||||
Dim m As Long
|
Dim m As Long
|
||||||
Dim k As Long
|
Dim k As Long
|
||||||
Dim OK As Boolean
|
Dim ok As Boolean
|
||||||
|
|
||||||
m = -1
|
m = -1
|
||||||
i = 0
|
i = 0
|
||||||
While i <= UBound(tbl, 1)
|
While i <= UBound(tbl, 1)
|
||||||
k = 0
|
k = 0
|
||||||
OK = True
|
ok = True
|
||||||
Do While k <= UBound(column())
|
Do While k <= UBound(column())
|
||||||
If i = column(k) Then
|
If i = column(k) Then
|
||||||
OK = False
|
ok = False
|
||||||
Exit Do
|
Exit Do
|
||||||
End If
|
End If
|
||||||
k = k + 1
|
k = k + 1
|
||||||
Loop
|
Loop
|
||||||
If OK = True Then
|
If ok = True Then
|
||||||
m = m + 1
|
m = m + 1
|
||||||
j = 0
|
j = 0
|
||||||
While j <= UBound(tbl, 2)
|
While j <= UBound(tbl, 2)
|
||||||
@ -1292,7 +1328,7 @@ Public Function MISCe_CompareDate(ByRef base As Date, ByRef compare As Date) As
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef range As Long, ByRef match As Boolean, ParamArray fldsvals()) As Long
|
Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef Range As Long, ByRef match As Boolean, ParamArray fldsvals()) As Long
|
||||||
|
|
||||||
On Error GoTo errpath
|
On Error GoTo errpath
|
||||||
'has to be a lexicographically sorted table otherwise this evaluaiton will not be the same as the sort evaluaiton
|
'has to be a lexicographically sorted table otherwise this evaluaiton will not be the same as the sort evaluaiton
|
||||||
@ -1362,7 +1398,7 @@ Public Function ROWe_FindOnSorted(ByRef tbl() As String, ByRef range As Long, By
|
|||||||
j = currow
|
j = currow
|
||||||
End If
|
End If
|
||||||
|
|
||||||
range = i
|
Range = i
|
||||||
ROWe_FindOnSorted = j
|
ROWe_FindOnSorted = j
|
||||||
match = True
|
match = True
|
||||||
Exit Function
|
Exit Function
|
||||||
@ -1429,7 +1465,7 @@ Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITL
|
|||||||
MsgB.Caption = TITLE
|
MsgB.Caption = TITLE
|
||||||
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
|
MsgB.tbMSG.ScrollBars = fmScrollBarsBoth
|
||||||
MsgB.Show
|
MsgB.Show
|
||||||
MISC_msgbox_cancel = MsgB.Cancel
|
MISC_msgbox_cancel = MsgB.cancel
|
||||||
Application.EnableCancelKey = xlInterrupt
|
Application.EnableCancelKey = xlInterrupt
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
@ -1585,7 +1621,7 @@ Sub SHTp_HyperlinkConvert(ByRef sheet As Worksheet, ByRef column As Integer, ByR
|
|||||||
Set sh = sheet
|
Set sh = sheet
|
||||||
i = startrow
|
i = startrow
|
||||||
Do Until sh.Cells(i, column) = stopflag
|
Do Until sh.Cells(i, column) = stopflag
|
||||||
Call sh.Hyperlinks.Add(sh.range(sh.Cells(i, column).Address), sh.Cells(i, column))
|
Call sh.Hyperlinks.Add(sh.Range(sh.Cells(i, column).address), sh.Cells(i, column))
|
||||||
i = i + 1
|
i = i + 1
|
||||||
Loop
|
Loop
|
||||||
|
|
||||||
@ -1633,7 +1669,8 @@ Function FILEp_CreateCSV(ByRef path As String, ByRef recs() As String) As Boolea
|
|||||||
|
|
||||||
|
|
||||||
tsf.Type = 2
|
tsf.Type = 2
|
||||||
tsf.Charset = "utf-8"
|
'tsf.Charset = "utf-8"
|
||||||
|
tsf.Charset = "Windows-1252"
|
||||||
tsf.Open
|
tsf.Open
|
||||||
|
|
||||||
'Set ts = f.OpenTextFile(path, ForReading, False, TristateUseDefault)
|
'Set ts = f.OpenTextFile(path, ForReading, False, TristateUseDefault)
|
||||||
@ -1643,10 +1680,10 @@ Function FILEp_CreateCSV(ByRef path As String, ByRef recs() As String) As Boolea
|
|||||||
For j = 0 To UBound(recs, 1)
|
For j = 0 To UBound(recs, 1)
|
||||||
If j = 0 Then
|
If j = 0 Then
|
||||||
test_empty = Replace(Replace(recs(j, i), ",", ""), """", "")
|
test_empty = Replace(Replace(recs(j, i), ",", ""), """", "")
|
||||||
wl = """" & Replace(Replace(recs(j, i), ",", ""), """", "") & """"
|
wl = Replace(Replace(recs(j, i), ",", ""), """", "")
|
||||||
Else
|
Else
|
||||||
test_empty = test_empty & Replace(Replace(recs(j, i), ",", ""), """", "")
|
test_empty = test_empty & Replace(Replace(recs(j, i), ",", ""), """", "")
|
||||||
wl = wl & ",""" & Replace(Replace(recs(j, i), ",", ""), """", "") & """"
|
wl = wl & "," & Replace(Replace(recs(j, i), ",", ""), """", "")
|
||||||
End If
|
End If
|
||||||
Next j
|
Next j
|
||||||
If Len(test_empty) > 0 Then
|
If Len(test_empty) > 0 Then
|
||||||
@ -1948,7 +1985,7 @@ Function TXTp_ParseCSVrow(ByRef csv() As String, row As Long, col As Integer) As
|
|||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
|
||||||
Function json_from_list(keys As range, values As range) As String
|
Function json_from_list(keys As Range, values As Range) As String
|
||||||
|
|
||||||
Dim json As String
|
Dim json As String
|
||||||
Dim i As Integer
|
Dim i As Integer
|
||||||
@ -1977,7 +2014,7 @@ Function json_from_list(keys As range, values As range) As String
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Function json_concat(list As range) As String
|
Function json_concat(list As Range) As String
|
||||||
|
|
||||||
Dim json As String
|
Dim json As String
|
||||||
Dim i As Integer
|
Dim i As Integer
|
||||||
@ -2000,7 +2037,7 @@ Function json_concat(list As range) As String
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
|
Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, target As String, trim As Boolean, start As Long, ending As Long, ParamArray ftype()) As String
|
||||||
|
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
@ -2008,7 +2045,7 @@ Public Function ADOp_BuildInsertSQL(ByRef tbl() As String, Target As String, tri
|
|||||||
Dim sql As String
|
Dim sql As String
|
||||||
Dim rec As String
|
Dim rec As String
|
||||||
|
|
||||||
sql = "INSERT INTO " & Target & " VALUES " & vbCrLf
|
sql = "INSERT INTO " & target & " VALUES " & vbCrLf
|
||||||
For i = start To ending
|
For i = start To ending
|
||||||
rec = ""
|
rec = ""
|
||||||
If i <> start Then sql = sql & "," & vbCrLf
|
If i <> start Then sql = sql & "," & vbCrLf
|
||||||
@ -2133,7 +2170,7 @@ Public Function MISCe_MaxLng(ByRef base As Long, ByRef compare As Long) As Long
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function markdown_from_table(ByRef tbl() As Variant) As String
|
Public Function markdown_from_table(ByRef tbl() As Variant, Optional number_format As String) As String
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -2154,6 +2191,7 @@ Public Function markdown_from_table(ByRef tbl() As Variant) As String
|
|||||||
'---build markdown table-----------
|
'---build markdown table-----------
|
||||||
For r = 1 To UBound(tbl, 1)
|
For r = 1 To UBound(tbl, 1)
|
||||||
If r = 2 Then
|
If r = 2 Then
|
||||||
|
'If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
|
||||||
md = md & "|"
|
md = md & "|"
|
||||||
For c = 1 To UBound(tbl, 2)
|
For c = 1 To UBound(tbl, 2)
|
||||||
md = md & "---" & String(Me.MISCe_MaxInt(msl(c), 3) - 3, "-") & "|"
|
md = md & "---" & String(Me.MISCe_MaxInt(msl(c), 3) - 3, "-") & "|"
|
||||||
@ -2171,9 +2209,10 @@ Public Function markdown_from_table(ByRef tbl() As Variant) As String
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function json_multirange(ByRef r As range) As String
|
|
||||||
|
|
||||||
Dim ar As range
|
Public Function json_multirange(ByRef r As Range) As String
|
||||||
|
|
||||||
|
Dim ar As Range
|
||||||
Dim r1() As Variant
|
Dim r1() As Variant
|
||||||
Dim r2() As Variant
|
Dim r2() As Variant
|
||||||
Dim rslt As String
|
Dim rslt As String
|
||||||
@ -2207,7 +2246,7 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
|
|||||||
Dim x As New TheBigOne
|
Dim x As New TheBigOne
|
||||||
Dim tbl() As Variant
|
Dim tbl() As Variant
|
||||||
|
|
||||||
tbl = sh.range("A1:CZ1000").FormulaR1C1
|
tbl = sh.Range("A1:CZ1000").FormulaR1C1
|
||||||
|
|
||||||
For ic = 1 To UBound(tbl, 2)
|
For ic = 1 To UBound(tbl, 2)
|
||||||
For ir = 1 To UBound(tbl, 1)
|
For ir = 1 To UBound(tbl, 1)
|
||||||
@ -2218,13 +2257,13 @@ Function markdown_whole_sheet(ByRef sh As Worksheet) As String
|
|||||||
Next ir
|
Next ir
|
||||||
Next ic
|
Next ic
|
||||||
|
|
||||||
tbl = sh.range(sh.Cells(1, 1).Address & ":" & sh.Cells(mr, mc).Address).FormulaR1C1
|
tbl = sh.Range(sh.Cells(1, 1).address & ":" & sh.Cells(mr, mc).address).FormulaR1C1
|
||||||
|
|
||||||
markdown_whole_sheet = Me.markdown_from_table(tbl)
|
markdown_whole_sheet = Me.markdown_from_table(tbl)
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Function MISCe_colnum_to_letter(ByRef x As Long) As String
|
Function MISCe_col_to_letter(ByRef x As Long) As String
|
||||||
|
|
||||||
If x > 26 Then
|
If x > 26 Then
|
||||||
MISCe_colnum_to_letter = Chr(x \ 26 + 64) & Chr((x / 26 - x \ 26) * 26 + 64)
|
MISCe_colnum_to_letter = Chr(x \ 26 + 64) & Chr((x / 26 - x \ 26) * 26 + 64)
|
||||||
@ -2234,7 +2273,8 @@ Function MISCe_colnum_to_letter(ByRef x As Long) As String
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax) As String
|
|
||||||
|
Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax, ByRef quote_headers As Boolean) As String
|
||||||
|
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
@ -2244,6 +2284,17 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
|||||||
Dim type_flag() As String
|
Dim type_flag() As String
|
||||||
Dim col_name As String
|
Dim col_name As String
|
||||||
Dim start_row As Long
|
Dim start_row As Long
|
||||||
|
Dim rx As Object
|
||||||
|
Dim strip_text As String
|
||||||
|
Dim strip_num As String
|
||||||
|
Dim strip_date As String
|
||||||
|
|
||||||
|
Set rx = CreateObject("vbscript.regexp")
|
||||||
|
rx.Global = True
|
||||||
|
|
||||||
|
strip_text = "[^a-zA-Z0-9 \-\_\,\#\""]"
|
||||||
|
strip_num = "[^0-9\.]"
|
||||||
|
strip_date = "[^0-9\\\-\:\.]"
|
||||||
|
|
||||||
ReDim type_flag(UBound(tbl, 1))
|
ReDim type_flag(UBound(tbl, 1))
|
||||||
For j = 0 To UBound(tbl, 1)
|
For j = 0 To UBound(tbl, 1)
|
||||||
@ -2266,16 +2317,22 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
|||||||
End If
|
End If
|
||||||
Next j
|
Next j
|
||||||
|
|
||||||
|
rx.Pattern = strip_text
|
||||||
If headers Then
|
If headers Then
|
||||||
start_row = 1
|
start_row = 1
|
||||||
For i = 0 To UBound(tbl, 1)
|
For i = 0 To UBound(tbl, 1)
|
||||||
If i > 0 Then col_name = col_name & ","
|
If i > 0 Then col_name = col_name & ","
|
||||||
col_name = col_name & """" & tbl(i, 0) & """"
|
If quote_headers Then
|
||||||
|
col_name = col_name & """" & rx.Replace(tbl(i, 0), "") & """"
|
||||||
|
Else
|
||||||
|
col_name = col_name & rx.Replace(tbl(i, 0), "")
|
||||||
|
End If
|
||||||
Next i
|
Next i
|
||||||
Else
|
Else
|
||||||
start_row = 0
|
start_row = 0
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
|
||||||
For i = start_row To UBound(tbl, 2)
|
For i = start_row To UBound(tbl, 2)
|
||||||
rec = ""
|
rec = ""
|
||||||
If i <> start_row Then sql = sql & "," & vbCrLf
|
If i <> start_row Then sql = sql & "," & vbCrLf
|
||||||
@ -2284,35 +2341,40 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
|||||||
If j <> 0 Then rec = rec & ","
|
If j <> 0 Then rec = rec & ","
|
||||||
Select Case type_flag(j)
|
Select Case type_flag(j)
|
||||||
Case "N" '-------N = numeric but should probably be N for numeric----
|
Case "N" '-------N = numeric but should probably be N for numeric----
|
||||||
|
rx.Pattern = strip_num
|
||||||
If tbl(j, i) = "" Then
|
If tbl(j, i) = "" Then
|
||||||
rec = rec & "CAST(NULL AS NUMERIC)"
|
rec = rec & "CAST(NULL AS NUMERIC)"
|
||||||
Else
|
Else
|
||||||
rec = rec & Replace(Replace(tbl(j, i), "'", "''"), ",", "")
|
rec = rec & rx.Replace(tbl(j, i), "")
|
||||||
End If
|
End If
|
||||||
Case "S" '-------S = string------------------------------------------
|
Case "S" '-------S = string------------------------------------------
|
||||||
|
rx.Pattern = strip_text
|
||||||
If LTrim(RTrim(tbl(j, i))) = "" Then
|
If LTrim(RTrim(tbl(j, i))) = "" Then
|
||||||
rec = rec & "CAST(NULL AS VARCHAR(255))"
|
rec = rec & "CAST(NULL AS VARCHAR(255))"
|
||||||
Else
|
Else
|
||||||
If trim Then
|
If trim Then
|
||||||
rec = rec & "'" & LTrim(RTrim(Replace(tbl(j, i), "'", "''"))) & "'"
|
rec = rec & "'" & LTrim(RTrim(rx.Replace(tbl(j, i), ""))) & "'"
|
||||||
Else
|
Else
|
||||||
rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'"
|
rec = rec & "'" & rx.Replace(tbl(j, i), "") & "'"
|
||||||
|
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
Case "D" '-------D = date---------------------------------------------
|
Case "D" '-------D = date---------------------------------------------
|
||||||
|
rx.Pattern = strip_date
|
||||||
If LTrim(RTrim(tbl(j, i))) = "" Then
|
If LTrim(RTrim(tbl(j, i))) = "" Then
|
||||||
rec = rec & "CAST(NULL AS DATE)"
|
rec = rec & "CAST(NULL AS DATE)"
|
||||||
Else
|
Else
|
||||||
rec = rec & "CAST('" & tbl(j, i) & "' AS DATE)"
|
rec = rec & "CAST('" & rx.Replace(tbl(j, i), "") & "' AS DATE)"
|
||||||
End If
|
End If
|
||||||
Case Else '-------Assume text------------------------------------------
|
Case Else '-------Assume text------------------------------------------
|
||||||
|
rx.Pattern = strip_text
|
||||||
If LTrim(RTrim(tbl(j, i))) = "" Then
|
If LTrim(RTrim(tbl(j, i))) = "" Then
|
||||||
rec = rec & "CAST(NULL AS VARCHAR(255))"
|
rec = rec & "CAST(NULL AS VARCHAR(255))"
|
||||||
Else
|
Else
|
||||||
If trim Then
|
If trim Then
|
||||||
rec = rec & "'" & LTrim(RTrim(Replace(tbl(j, i), "'", "''"))) & "'"
|
rec = rec & "'" & LTrim(RTrim(rx.Replace(tbl(j, i), ""))) & "'"
|
||||||
Else
|
Else
|
||||||
rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'"
|
rec = rec & "'" & rx.Replace(tbl(j, i), "") & "'"
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
End Select
|
End Select
|
||||||
@ -2324,7 +2386,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
|||||||
Select Case syntax
|
Select Case syntax
|
||||||
Case SQLsyntax.Db2
|
Case SQLsyntax.Db2
|
||||||
sql = "SELECT * FROM TABLE( VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
sql = "SELECT * FROM TABLE( VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
||||||
Case SQLsyntax.SQLServer
|
Case SQLsyntax.SqlServer
|
||||||
sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
||||||
Case SQLsyntax.PostgreSQL
|
Case SQLsyntax.PostgreSQL
|
||||||
sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
sql = "SELECT * FROM (VALUES" & vbCrLf & sql & vbCrLf & ") x"
|
||||||
@ -2336,7 +2398,7 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
|||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function ARRAYp_get_range_string(ByRef r As range) As String()
|
Public Function ARRAYp_get_range_string(ByRef r As Range) As String()
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim j As Long
|
Dim j As Long
|
||||||
@ -2363,4 +2425,176 @@ Public Function ARRAYp_get_range_string(ByRef r As range) As String()
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Public Function TBLp_range(ByRef dump() As Variant, ByVal upperleft As Range) As Range
|
||||||
|
|
||||||
|
Dim width As Long
|
||||||
|
width = UBound(dump, 2)
|
||||||
|
Dim newcol As String
|
||||||
|
newcol = ConvertBase10(upperleft.column + UBound(dump, 2), "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
|
||||||
|
'credit: http://www.freevbcode.com/ShowCode.asp?ID=6604
|
||||||
|
|
||||||
|
Dim s As String, tmp As Double, i As Integer, lastI As Integer
|
||||||
|
Dim BaseSize As Integer
|
||||||
|
BaseSize = Len(sNewBaseDigits)
|
||||||
|
Do While Val(d) <> 0
|
||||||
|
tmp = d
|
||||||
|
i = 0
|
||||||
|
Do While tmp >= BaseSize
|
||||||
|
i = i + 1
|
||||||
|
tmp = tmp / BaseSize
|
||||||
|
Loop
|
||||||
|
If i <> lastI - 1 And lastI <> 0 Then s = s & String(lastI - i - 1, Left(sNewBaseDigits, 1)) 'get the zero digits inside the number
|
||||||
|
tmp = Int(tmp) 'truncate decimals
|
||||||
|
s = s + Mid(sNewBaseDigits, tmp + 1, 1)
|
||||||
|
d = d - tmp * (BaseSize ^ i)
|
||||||
|
lastI = i
|
||||||
|
Loop
|
||||||
|
s = s & String(i, Left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
|
||||||
|
Misc_ConvBase10 = s
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Public Function SHTp_get_block(point As Range) As Variant()
|
||||||
|
|
||||||
|
' Dim left As Long
|
||||||
|
' Dim right As Long
|
||||||
|
' Dim top As Long
|
||||||
|
' Dim bot As Long
|
||||||
|
' Dim i As Long
|
||||||
|
' Dim lcol As String
|
||||||
|
' Dim rcol As String
|
||||||
|
' Dim r As Range
|
||||||
|
'
|
||||||
|
'
|
||||||
|
' i = 0
|
||||||
|
' Do Until point.Worksheet.Cells(point.row, point.column + i) = ""
|
||||||
|
' i = i + 1
|
||||||
|
' Loop
|
||||||
|
' If i <> 0 Then i = i - 1
|
||||||
|
' right = point.column + i
|
||||||
|
'
|
||||||
|
' i = 0
|
||||||
|
' Do Until point.Worksheet.Cells(point.row, point.column + i) = ""
|
||||||
|
' i = i - 1
|
||||||
|
' Loop
|
||||||
|
' If i <> 0 Then i = i + 1
|
||||||
|
' left = point.column + i
|
||||||
|
'
|
||||||
|
' i = 0
|
||||||
|
' Do Until point.Worksheet.Cells(point.row + i, point.column) = ""
|
||||||
|
' i = i + 1
|
||||||
|
' Loop
|
||||||
|
' If i <> 0 Then i = i - 1
|
||||||
|
' bot = point.row + i
|
||||||
|
'
|
||||||
|
' i = 0
|
||||||
|
' Do Until point.Worksheet.Cells(point.row + i, point.column) = ""
|
||||||
|
' i = i - 1
|
||||||
|
' If point.row + i < 1 Then Exit Do
|
||||||
|
' Loop
|
||||||
|
' If i <> 0 Then i = i + 1
|
||||||
|
' top = point.row + i
|
||||||
|
'
|
||||||
|
' lcol = Me.ColumnLetter(left)
|
||||||
|
' rcol = Me.ColumnLetter(right)
|
||||||
|
'point.row (right)
|
||||||
|
|
||||||
|
SHTp_get_block = point.CurrentRegion
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Public Function SHTp_GetString(point As Range) As String()
|
||||||
|
|
||||||
|
Dim x() As String
|
||||||
|
Dim pl() As Variant
|
||||||
|
pl = point.CurrentRegion
|
||||||
|
|
||||||
|
SHTp_GetString = Me.TBLp_Transpose(Me.TBLp_VarToString(pl))
|
||||||
|
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
Function ColumnLetter(ColumnNumber As Long) As String
|
||||||
|
Dim n As Long
|
||||||
|
Dim c As Byte
|
||||||
|
Dim s As String
|
||||||
|
|
||||||
|
n = ColumnNumber
|
||||||
|
Do
|
||||||
|
c = ((n - 1) Mod 26)
|
||||||
|
s = Chr(c + 65) & s
|
||||||
|
n = (n - c) \ 26
|
||||||
|
Loop While n > 0
|
||||||
|
ColumnLetter = s
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Function TBLp_TestNumeric(ByRef table() As String, ByRef column As Long) As Boolean
|
||||||
|
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim m As Long
|
||||||
|
|
||||||
|
TBLp_TestNumeric = True
|
||||||
|
|
||||||
|
j = 0
|
||||||
|
i = 1
|
||||||
|
For i = 1 To UBound(table, 2)
|
||||||
|
If Not IsNumeric(table(column, i)) And table(column, i) <> "" Then
|
||||||
|
TBLp_TestNumeric = False
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Function TBLp_Transpose(ByRef t() As String) As String()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim x() As String
|
||||||
|
|
||||||
|
If LBound(t, 1) = 1 Then
|
||||||
|
End If
|
||||||
|
|
||||||
|
ReDim x(LBound(t, 2) To UBound(t, 2), LBound(t, 1) To UBound(t, 1))
|
||||||
|
|
||||||
|
For i = 1 To UBound(t, 2)
|
||||||
|
For j = 1 To UBound(t, 1)
|
||||||
|
x(i, j) = t(j, i)
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
|
||||||
|
TBLp_Transpose = x
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Function TBLp_VarToString(ByRef t() As Variant) As String()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim x() As String
|
||||||
|
|
||||||
|
If LBound(t, 1) = 1 Then
|
||||||
|
End If
|
||||||
|
|
||||||
|
ReDim x(LBound(t, 1) To UBound(t, 1), LBound(t, 2) To UBound(t, 2))
|
||||||
|
|
||||||
|
For i = LBound(t, 1) To UBound(t, 1)
|
||||||
|
For j = LBound(t, 2) To UBound(t, 2)
|
||||||
|
x(i, j) = t(i, j)
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
|
||||||
|
TBLp_VarToString = x
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
78
build.frm
Normal file
78
build.frm
Normal file
@ -0,0 +1,78 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} build
|
||||||
|
Caption = "UserForm1"
|
||||||
|
ClientHeight = 3015
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 8100
|
||||||
|
OleObjectBlob = "build.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "build"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Public part As String
|
||||||
|
Public bill As String
|
||||||
|
Public ship As String
|
||||||
|
Public useval As Boolean
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
useval = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
useval = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbShip_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
useval = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub UserForm_Activate()
|
||||||
|
|
||||||
|
useval = False
|
||||||
|
|
||||||
|
cbPart.value = part
|
||||||
|
cbBill.value = bill
|
||||||
|
cbShip.value = ship
|
||||||
|
|
||||||
|
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
|
||||||
|
cbBill.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
|
||||||
|
cbShip.list = Application.transpose(Worksheets("mdata").Range("D2:D14295"))
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
53
changes.frm
Normal file
53
changes.frm
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} changes
|
||||||
|
Caption = "History"
|
||||||
|
ClientHeight = 7740
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 16260
|
||||||
|
OleObjectBlob = "changes.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "changes"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Private x As Variant
|
||||||
|
|
||||||
|
Private Sub cbCancel_Click()
|
||||||
|
|
||||||
|
Me.Hide
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub lbHist_Change()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
For i = 0 To Me.lbHist.ListCount - 1
|
||||||
|
If Me.lbHist.Selected(i) Then
|
||||||
|
Me.tbPrint.value = x(i, 4)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub UserForm_Activate()
|
||||||
|
|
||||||
|
Dim fail As Boolean
|
||||||
|
|
||||||
|
x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
|
||||||
|
If fail Then
|
||||||
|
Me.Hide
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Me.lbHist.list = x
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
BIN
changes.frx
Normal file
BIN
changes.frx
Normal file
Binary file not shown.
929
fpvt.frm
Normal file
929
fpvt.frm
Normal file
@ -0,0 +1,929 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
|
||||||
|
Caption = "Forecast Adjustment"
|
||||||
|
ClientHeight = 7350
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 7110
|
||||||
|
OleObjectBlob = "fpvt.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "fpvt"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Public mod_adjust As Boolean
|
||||||
|
Private month() As Variant
|
||||||
|
Private mload() As Variant
|
||||||
|
Private adjust As Object
|
||||||
|
Private nomonth As Boolean
|
||||||
|
Private mline As Integer
|
||||||
|
Private clear_lb As Boolean
|
||||||
|
Private load_tb As Boolean
|
||||||
|
Private set_Price As Boolean
|
||||||
|
Private sp As Object
|
||||||
|
Private basket() As Variant
|
||||||
|
|
||||||
|
Private bVol As Double
|
||||||
|
Private bVal As Double
|
||||||
|
Private bPrc As Double
|
||||||
|
Private pVol As Double
|
||||||
|
Private pVal As Double
|
||||||
|
Private pPrc As Double
|
||||||
|
Private aVol As Double
|
||||||
|
Private aVal As Double
|
||||||
|
Private aPrc As Double
|
||||||
|
Private fVol As Double
|
||||||
|
Private fVal As Double
|
||||||
|
Private fPrc As Double
|
||||||
|
|
||||||
|
Private bVolm As Double
|
||||||
|
Private bValm As Double
|
||||||
|
Private bPrcm As Double
|
||||||
|
Private pVolm As Double
|
||||||
|
Private pValm As Double
|
||||||
|
Private pPrcm As Double
|
||||||
|
Private aVolm As Double
|
||||||
|
Private aValm As Double
|
||||||
|
Private aPrcm As Double
|
||||||
|
Private fVolm As Double
|
||||||
|
Private fValm As Double
|
||||||
|
Private fPrcm As Double
|
||||||
|
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
Private Sub cbCancel_Click()
|
||||||
|
|
||||||
|
tbAdjVol.value = 0
|
||||||
|
tbAdjVal.value = 0
|
||||||
|
tbAdjPrice.value = 0
|
||||||
|
fpvt.Hide
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub butAdjust_Click()
|
||||||
|
|
||||||
|
Dim fail As Boolean
|
||||||
|
|
||||||
|
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
|
||||||
|
If fail Then
|
||||||
|
MsgBox ("adjustment was not made due to error")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Me.Hide
|
||||||
|
|
||||||
|
Set adjust = Nothing
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub butCancel_Click()
|
||||||
|
Me.Hide
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub butMAdjust_Click()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
For i = 1 To 12
|
||||||
|
If month(i, 10) <> "" Then
|
||||||
|
Call handler.request_adjust(CStr(month(i, 10)))
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Me.Hide
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub butMCancel_Click()
|
||||||
|
|
||||||
|
Me.Hide
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub cbGoSheet_Click()
|
||||||
|
|
||||||
|
Me.Hide
|
||||||
|
Worksheets("month").Visible = xlSheetVisible
|
||||||
|
Sheets("month").Select
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub lbMonth_Change()
|
||||||
|
|
||||||
|
If clear_lb Or load_tb Then Exit Sub
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
For i = 0 To 13
|
||||||
|
If lbMonth.Selected(i) Then
|
||||||
|
mline = i
|
||||||
|
If i <> 0 And i <> 13 Then
|
||||||
|
Me.load_var
|
||||||
|
Me.load_mbox
|
||||||
|
Else
|
||||||
|
load_tb = True
|
||||||
|
tbMBaseVal.value = ""
|
||||||
|
tbMBaseVol.value = ""
|
||||||
|
tbMBasePrice.value = ""
|
||||||
|
tbmPAVal.value = ""
|
||||||
|
tbMPAVol.value = ""
|
||||||
|
tbMPAPrice.value = ""
|
||||||
|
tbMFVal.value = ""
|
||||||
|
tbMFVol.value = ""
|
||||||
|
tbMFPrice.value = ""
|
||||||
|
tbMAVal.value = ""
|
||||||
|
tbMAVol.value = ""
|
||||||
|
tbMAPrice.value = ""
|
||||||
|
load_tb = False
|
||||||
|
End If
|
||||||
|
Exit For
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub lheader_Click()
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opEditPrice_Click()
|
||||||
|
|
||||||
|
opPlugVol.Enabled = False
|
||||||
|
opPlugPrice.Enabled = False
|
||||||
|
opPlugVol.Visible = False
|
||||||
|
opPlugPrice.Visible = False
|
||||||
|
opPlugPrice.value = True
|
||||||
|
opPlugVol.value = False
|
||||||
|
|
||||||
|
tbFcPrice.Enabled = True
|
||||||
|
tbFcPrice.BackColor = &H80000018
|
||||||
|
tbFcVal.Enabled = False
|
||||||
|
tbFcVal.BackColor = &H80000005
|
||||||
|
tbFcVol.Enabled = True
|
||||||
|
tbFcVol.BackColor = &H80000018
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opEditSales_Click()
|
||||||
|
|
||||||
|
opPlugVol.Enabled = True
|
||||||
|
opPlugPrice.Enabled = True
|
||||||
|
opPlugVol.Visible = True
|
||||||
|
opPlugPrice.Visible = True
|
||||||
|
|
||||||
|
tbFcPrice.Enabled = False
|
||||||
|
tbFcPrice.BackColor = &H80000005
|
||||||
|
tbFcVal.Enabled = True
|
||||||
|
tbFcVal.BackColor = &H80000018
|
||||||
|
tbFcVol.Enabled = False
|
||||||
|
tbFcVol.BackColor = &H80000005
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub opEditPriceM_Click()
|
||||||
|
|
||||||
|
opmvol.Enabled = False
|
||||||
|
opmprice.Enabled = False
|
||||||
|
opmvol.Visible = False
|
||||||
|
opmprice.Visible = False
|
||||||
|
opmprice.value = True
|
||||||
|
opmvol.value = True
|
||||||
|
|
||||||
|
tbMFPrice.Enabled = True
|
||||||
|
tbMFPrice.BackColor = &H80000018
|
||||||
|
tbMFVal.Enabled = False
|
||||||
|
tbMFVal.BackColor = &H80000005
|
||||||
|
tbMFVol.Enabled = True
|
||||||
|
tbMFVol.BackColor = &H80000018
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opEditSalesM_Click()
|
||||||
|
|
||||||
|
opmvol.Enabled = True
|
||||||
|
opmprice.Enabled = True
|
||||||
|
opmvol.Visible = True
|
||||||
|
opmprice.Visible = True
|
||||||
|
|
||||||
|
tbMFPrice.Enabled = False
|
||||||
|
tbMFPrice.BackColor = &H80000005
|
||||||
|
tbMFVal.Enabled = True
|
||||||
|
tbMFVal.BackColor = &H80000018
|
||||||
|
tbMFVol.Enabled = False
|
||||||
|
tbMFVol.BackColor = &H80000005
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opEditVolM_Click()
|
||||||
|
|
||||||
|
opmvol.Enabled = False
|
||||||
|
opmprice.Enabled = False
|
||||||
|
opmprice.value = False
|
||||||
|
opmvol.value = True
|
||||||
|
opmvol.Enabled = False
|
||||||
|
opmprice.Enabled = False
|
||||||
|
opmvol.Visible = False
|
||||||
|
opmprice.Visible = False
|
||||||
|
|
||||||
|
tbMFPrice.Enabled = False
|
||||||
|
tbMFPrice.BackColor = &H80000005
|
||||||
|
tbMFVal.Enabled = False
|
||||||
|
tbMFVal.BackColor = &H80000005
|
||||||
|
tbMFVol.Enabled = True
|
||||||
|
tbMFVol.BackColor = &H80000018
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opPlugPrice_Click()
|
||||||
|
calc_val
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opPlugVol_Click()
|
||||||
|
calc_val
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub tbFcPrice_Change()
|
||||||
|
If load_tb Then Exit Sub
|
||||||
|
set_Price = True
|
||||||
|
If opEditPrice Then calc_price
|
||||||
|
set_Price = False
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub tbFcVal_Change()
|
||||||
|
If load_tb Then Exit Sub
|
||||||
|
If opEditSales Then calc_val
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub tbFcVol_Change()
|
||||||
|
If load_tb Then Exit Sub
|
||||||
|
If opEditPrice Then calc_price
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
'--------------------------------monthly buttons--------------------------------------
|
||||||
|
|
||||||
|
Private Sub opmPrice_Click()
|
||||||
|
calc_mval
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub opmVol_Click()
|
||||||
|
calc_mval
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub tbmfPrice_Change()
|
||||||
|
If mline = 0 Then Exit Sub
|
||||||
|
If clear_lb Or load_tb Then Exit Sub
|
||||||
|
set_Price = True
|
||||||
|
If opEditPriceM Then calc_mprice
|
||||||
|
set_Price = False
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub tbMFVal_Change()
|
||||||
|
If mline = 0 Then Exit Sub
|
||||||
|
If clear_lb Or load_tb Then Exit Sub
|
||||||
|
If opEditSalesM Then calc_mval
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub tbmfVol_Change()
|
||||||
|
If mline = 0 Then Exit Sub
|
||||||
|
If clear_lb Or load_tb Then Exit Sub
|
||||||
|
If opEditPriceM Then calc_mprice
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub UserForm_Activate()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim k As Long
|
||||||
|
Dim ok As Boolean
|
||||||
|
|
||||||
|
Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
|
||||||
|
Me.mp.Visible = False
|
||||||
|
|
||||||
|
Me.lheader = "Loading..."
|
||||||
|
|
||||||
|
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
|
||||||
|
|
||||||
|
Me.lheader = "Ready"
|
||||||
|
|
||||||
|
If Not ok Then
|
||||||
|
fpvt.Hide
|
||||||
|
Application.StatusBar = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
|
||||||
|
'---show existing adjustment if there is one----
|
||||||
|
fpvt.mod_adjust = False
|
||||||
|
pVol = 0
|
||||||
|
pVal = 0
|
||||||
|
pPrc = 0
|
||||||
|
bVol = 0
|
||||||
|
bVal = 0
|
||||||
|
bPrc = 0
|
||||||
|
aVol = 0
|
||||||
|
aVal = 0
|
||||||
|
aPrc = 0
|
||||||
|
fVal = 0
|
||||||
|
fVol = 0
|
||||||
|
fPrc = 0
|
||||||
|
Me.tbAPI.value = ""
|
||||||
|
|
||||||
|
If IsNull(sp("package")("totals")) Then
|
||||||
|
fpvt.Hide
|
||||||
|
Application.StatusBar = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
For i = 1 To sp("package")("totals").Count
|
||||||
|
Select Case sp("package")("totals")(i)("order_season")
|
||||||
|
Case 2020
|
||||||
|
Select Case Me.iter_def(sp("package")("totals")(i)("iter"))
|
||||||
|
Case "baseline"
|
||||||
|
bVol = bVol + sp("package")("totals")(i)("units")
|
||||||
|
bVal = bVal + sp("package")("totals")(i)("value_usd")
|
||||||
|
If bVol <> 0 Then bPrc = bVal / bVol
|
||||||
|
|
||||||
|
Case "adjust"
|
||||||
|
pVol = pVol + sp("package")("totals")(i)("units")
|
||||||
|
pVal = pVal + sp("package")("totals")(i)("value_usd")
|
||||||
|
|
||||||
|
Case "exclude"
|
||||||
|
|
||||||
|
End Select
|
||||||
|
End Select
|
||||||
|
Next i
|
||||||
|
|
||||||
|
fVol = bVol + pVol
|
||||||
|
fVal = bVal + pVal
|
||||||
|
If fVol = 0 Then
|
||||||
|
fPrc = 0
|
||||||
|
Else
|
||||||
|
fPrc = fVal / fVol
|
||||||
|
End If
|
||||||
|
If (bVol + pVol) = 0 Then
|
||||||
|
pPrc = 0
|
||||||
|
Else
|
||||||
|
If bVol = 0 Then
|
||||||
|
pPrc = 0
|
||||||
|
Else
|
||||||
|
pPrc = (pVal + bVal) / (bVol + pVol) - bVal / bVol
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
If aVal <> 0 Then
|
||||||
|
MsgBox (aVal)
|
||||||
|
End If
|
||||||
|
Me.load_mbox_ann
|
||||||
|
|
||||||
|
'---------------------------------------populate monthly-------------------------------------------------------
|
||||||
|
|
||||||
|
k = 0
|
||||||
|
'--parse json into variant array for loading--
|
||||||
|
ReDim month(sp("package")("mpvt").Count + 1, 10)
|
||||||
|
|
||||||
|
For i = 1 To sp("package")("mpvt").Count
|
||||||
|
month(i, 0) = sp("package")("mpvt")(i)("order_month")
|
||||||
|
month(i, 1) = sp("package")("mpvt")(i)("2019 qty")
|
||||||
|
month(i, 2) = sp("package")("mpvt")(i)("2020 base qty")
|
||||||
|
month(i, 3) = sp("package")("mpvt")(i)("2020 adj qty")
|
||||||
|
month(i, 4) = sp("package")("mpvt")(i)("2020 tot qty")
|
||||||
|
month(i, 5) = sp("package")("mpvt")(i)("2019 value_usd")
|
||||||
|
month(i, 6) = sp("package")("mpvt")(i)("2020 base value_usd")
|
||||||
|
month(i, 7) = sp("package")("mpvt")(i)("2020 adj value_usd")
|
||||||
|
month(i, 8) = sp("package")("mpvt")(i)("2020 tot value_usd")
|
||||||
|
If co_num(month(i, 2), 0) = 0 Then
|
||||||
|
month(i, 9) = "addmonth"
|
||||||
|
Else
|
||||||
|
month(i, 9) = "scale"
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
month(0, 0) = "month"
|
||||||
|
month(13, 0) = "total"
|
||||||
|
month(0, 1) = "2019 qty"
|
||||||
|
month(0, 2) = "2020 base qty"
|
||||||
|
month(0, 3) = "2020 adj qty"
|
||||||
|
month(0, 4) = "2020 qty"
|
||||||
|
month(0, 5) = "2019 val"
|
||||||
|
month(0, 6) = "2020 base val"
|
||||||
|
month(0, 7) = "2020 adj val"
|
||||||
|
month(0, 8) = "2020 val"
|
||||||
|
|
||||||
|
Me.crunch_array
|
||||||
|
|
||||||
|
ReDim basket(sp("package")("basket").Count, 3)
|
||||||
|
|
||||||
|
' basket(0, 0) = "order_season"
|
||||||
|
' basket(0, 1) = "order_month"
|
||||||
|
' basket(0, 2) = "version"
|
||||||
|
' basket(0, 3) = "iter"
|
||||||
|
' basket(0, 4) = "part_descr"
|
||||||
|
' basket(0, 5) = "bill_cust_descr"
|
||||||
|
' basket(0, 6) = "ship_cust_descr"
|
||||||
|
' basket(0, 7) = "units"
|
||||||
|
' basket(0, 8) = "value_usd"
|
||||||
|
basket(0, 0) = "part_descr"
|
||||||
|
basket(0, 1) = "bill_cust_descr"
|
||||||
|
basket(0, 2) = "ship_cust_descr"
|
||||||
|
basket(0, 3) = "mix"
|
||||||
|
|
||||||
|
|
||||||
|
For i = 1 To UBound(basket, 1)
|
||||||
|
'basket(i, 0) = sp("package")("base")(i)("order_season")
|
||||||
|
'basket(i, 1) = sp("package")("base")(i)("order_month")
|
||||||
|
'basket(i, 2) = sp("package")("base")(i)("version")
|
||||||
|
'basket(i, 3) = sp("package")("base")(i)("iter")
|
||||||
|
'basket(i, 4) = sp("package")("base")(i)("part_descr")
|
||||||
|
'basket(i, 5) = sp("package")("base")(i)("bill_cust_descr")
|
||||||
|
'basket(i, 6) = sp("package")("base")(i)("ship_cust_descr")
|
||||||
|
'basket(i, 7) = sp("package")("base")(i)("units")
|
||||||
|
'basket(i, 8) = sp("package")("base")(i)("value_usd")
|
||||||
|
basket(i, 0) = sp("package")("basket")(i)("part_descr")
|
||||||
|
basket(i, 1) = sp("package")("basket")(i)("bill_cust_descr")
|
||||||
|
basket(i, 2) = sp("package")("basket")(i)("ship_cust_descr")
|
||||||
|
basket(i, 3) = sp("package")("basket")(i)("mix")
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Call handler.month_tosheet(month, basket)
|
||||||
|
Application.StatusBar = False
|
||||||
|
|
||||||
|
Me.mp.Visible = True
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub crunch_array()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
month(13, 1) = 0
|
||||||
|
month(13, 2) = 0
|
||||||
|
month(13, 3) = 0
|
||||||
|
month(13, 4) = 0
|
||||||
|
month(13, 5) = 0
|
||||||
|
month(13, 6) = 0
|
||||||
|
month(13, 7) = 0
|
||||||
|
month(13, 8) = 0
|
||||||
|
|
||||||
|
For i = 1 To 12
|
||||||
|
month(13, 1) = month(13, 1) + co_num(month(i, 1), 0)
|
||||||
|
month(13, 2) = month(13, 2) + co_num(month(i, 2), 0)
|
||||||
|
month(13, 3) = month(13, 3) + co_num(month(i, 3), 0)
|
||||||
|
month(13, 4) = month(13, 4) + co_num(month(i, 4), 0)
|
||||||
|
month(13, 5) = month(13, 5) + co_num(month(i, 5), 0)
|
||||||
|
month(13, 6) = month(13, 6) + co_num(month(i, 6), 0)
|
||||||
|
month(13, 7) = month(13, 7) + co_num(month(i, 7), 0)
|
||||||
|
month(13, 8) = month(13, 8) + co_num(month(i, 8), 0)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
ReDim mload(UBound(month, 1), 5)
|
||||||
|
For i = 0 To UBound(month, 1)
|
||||||
|
mload(i, 0) = Format(month(i, 0), "#,###")
|
||||||
|
mload(i, 1) = Format(month(i, 1), "#,###")
|
||||||
|
mload(i, 2) = Format(month(i, 4), "#,###")
|
||||||
|
mload(i, 3) = Format(month(i, 5), "#,###")
|
||||||
|
mload(i, 4) = Format(month(i, 8), "#,###")
|
||||||
|
Next i
|
||||||
|
|
||||||
|
'mline = 0
|
||||||
|
clear_lb = True
|
||||||
|
lbMonth.clear
|
||||||
|
lbMonth.list = mload
|
||||||
|
clear_lb = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub load_var()
|
||||||
|
|
||||||
|
'base
|
||||||
|
bVolm = co_num(month(mline, 2), 0)
|
||||||
|
bValm = co_num(month(mline, 6), 0)
|
||||||
|
|
||||||
|
'prior adjust
|
||||||
|
pVolm = co_num(month(mline, 3), 0)
|
||||||
|
pValm = co_num(month(mline, 7), 0)
|
||||||
|
|
||||||
|
'current forecast
|
||||||
|
fVolm = co_num(month(mline, 4), 0)
|
||||||
|
fValm = co_num(month(mline, 8), 0)
|
||||||
|
|
||||||
|
'adjustment
|
||||||
|
aVolm = fVolm - (bVolm + pVolm)
|
||||||
|
aValm = fValm - (bValm + pValm)
|
||||||
|
|
||||||
|
|
||||||
|
If month(mline, 9) = "addmonth" Then
|
||||||
|
nomonth = True
|
||||||
|
bPrcm = month(13, 6) / month(13, 2)
|
||||||
|
fPrcm = month(13, 8) / month(13, 4)
|
||||||
|
|
||||||
|
Else
|
||||||
|
'prices
|
||||||
|
If bVolm <> 0 Then bPrcm = bValm / bVolm
|
||||||
|
If (bVolm + pVolm) <> 0 Then pPrcm = (pValm + bValm) / (bVolm + pVolm) - bPrcm
|
||||||
|
If fVolm <> 0 Then fPrcm = fValm / fVolm
|
||||||
|
aPrcm = fPrcm - (bPrcm + pPrcm)
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub load_mbox()
|
||||||
|
|
||||||
|
load_tb = True
|
||||||
|
|
||||||
|
tbMBaseVol = Format(bVolm, "#,###")
|
||||||
|
tbMBaseVal = Format(bValm, "#,###")
|
||||||
|
tbMBasePrice = Format(bPrcm, "0.000")
|
||||||
|
|
||||||
|
tbMPAVol = Format(pVolm, "#,###")
|
||||||
|
tbmPAVal = Format(pValm, "#,###")
|
||||||
|
tbMPAPrice = Format(pPrcm, "0.000")
|
||||||
|
|
||||||
|
tbMFVol = Format(fVolm, "#,###")
|
||||||
|
tbMFVal = Format(fValm, "#,###")
|
||||||
|
If Not set_Price Then tbMFPrice = Format(fPrcm, "0.###")
|
||||||
|
|
||||||
|
tbMAVol = Format(aVolm, "#,###")
|
||||||
|
tbMAVal = Format(aValm, "#,###")
|
||||||
|
tbMAPrice = Format(aPrcm, "0.000")
|
||||||
|
|
||||||
|
load_tb = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub load_mbox_ann()
|
||||||
|
|
||||||
|
load_tb = True
|
||||||
|
|
||||||
|
tbBaseVol = Format(bVol, "#,##0")
|
||||||
|
tbBaseVal = Format(bVal, "#,##0")
|
||||||
|
tbBasePrice = Format(bPrc, "0.000")
|
||||||
|
|
||||||
|
tbPadjVol = Format(pVol, "#,##0")
|
||||||
|
tbPadjVal = Format(pVal, "#,##0")
|
||||||
|
tbPadjPrice = Format(pPrc, "0.000")
|
||||||
|
|
||||||
|
tbFcVol = Format(fVol, "#,##0")
|
||||||
|
tbFcVal = Format(fVal, "#,##0")
|
||||||
|
If Not set_Price Then tbFcPrice = Format(fPrc, "0.000")
|
||||||
|
|
||||||
|
tbAdjVol = Format(aVol, "#,##0")
|
||||||
|
tbAdjVal = Format(aVal, "#,##0")
|
||||||
|
tbAdjPrice = Format(aPrc, "0.000")
|
||||||
|
|
||||||
|
load_tb = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub load_array()
|
||||||
|
|
||||||
|
'base
|
||||||
|
month(mline, 2) = bVolm
|
||||||
|
month(mline, 6) = bValm
|
||||||
|
|
||||||
|
'prior adjust
|
||||||
|
month(mline, 3) = pVolm
|
||||||
|
month(mline, 7) = pValm
|
||||||
|
|
||||||
|
'current forecast
|
||||||
|
month(mline, 4) = fVolm
|
||||||
|
month(mline, 8) = fValm
|
||||||
|
|
||||||
|
Me.crunch_array
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
|
||||||
|
|
||||||
|
If Not IsNumeric(one) Or IsNull(one) Then
|
||||||
|
co_num = two
|
||||||
|
Else
|
||||||
|
co_num = one
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub calc_val()
|
||||||
|
|
||||||
|
Dim pchange As Double
|
||||||
|
|
||||||
|
If IsNumeric(tbFcVal.value) Then
|
||||||
|
'get textbox value
|
||||||
|
fVal = tbFcVal.value
|
||||||
|
'do calculations
|
||||||
|
aVal = fVal - bVal - pVal
|
||||||
|
|
||||||
|
'---------if volume adjustment method is selected, scale the volume up----------------------------------
|
||||||
|
If opPlugVol Then
|
||||||
|
If (Round(pVal, 2) + Round(bVal, 2)) = 0 Then
|
||||||
|
pchange = 0
|
||||||
|
If co_num(pVal, bVal) = 0 Then
|
||||||
|
MsgBox ("a new part was added, and then adjusted to -0-")
|
||||||
|
Else
|
||||||
|
fVol = fVal / (co_num(bVal, pVal) / co_num(bVol, pVol))
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
pchange = fVal / (pVal + bVal)
|
||||||
|
fVol = (pVol + bVol) * pchange
|
||||||
|
End If
|
||||||
|
|
||||||
|
Else
|
||||||
|
fVol = pVol + bVol
|
||||||
|
End If
|
||||||
|
If fVol = 0 Then
|
||||||
|
fPrc = 0
|
||||||
|
Else
|
||||||
|
fPrc = fVal / fVol
|
||||||
|
End If
|
||||||
|
aVol = fVol - (bVol + pVol)
|
||||||
|
aPrc = fPrc - (bPrc + pPrc)
|
||||||
|
Else
|
||||||
|
aVol = fVol - bVol - pVol
|
||||||
|
aPrc = 0
|
||||||
|
|
||||||
|
End If
|
||||||
|
tbFcVal = Format(co_num(tbFcVal, 0), "#,##0")
|
||||||
|
|
||||||
|
Me.load_mbox_ann
|
||||||
|
|
||||||
|
'build json
|
||||||
|
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
||||||
|
adjust("scenario")("version") = "b20"
|
||||||
|
adjust("scenario")("iter") = handler.basis
|
||||||
|
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
adjust("user") = Application.UserName
|
||||||
|
adjust("source") = "adj"
|
||||||
|
If opEditSales Then
|
||||||
|
If opPlugVol Then
|
||||||
|
adjust("type") = "scale_v"
|
||||||
|
adjust("amount") = aVal
|
||||||
|
adjust("qty") = aVol
|
||||||
|
Else
|
||||||
|
adjust("type") = "scale_p"
|
||||||
|
adjust("amount") = aVal
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
adjust("type") = "scale_vp"
|
||||||
|
adjust("qty") = aVol
|
||||||
|
adjust("amount") = aVal
|
||||||
|
End If
|
||||||
|
|
||||||
|
'print json
|
||||||
|
tbAPI = JsonConverter.ConvertToJson(adjust)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub calc_price()
|
||||||
|
|
||||||
|
'If IsNumeric(tbFcPrice.value) And tbFcPrice.value <> 0 And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
|
||||||
|
'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) And tbFcVol.value <> 0 Then
|
||||||
|
|
||||||
|
'If IsNumeric(tbFcPrice.value) And IsNumeric(tbFcVol.value) Then
|
||||||
|
'capture currently changed item
|
||||||
|
|
||||||
|
fVol = co_num(tbFcVol.value, 0)
|
||||||
|
fPrc = co_num(tbFcPrice.value, 0)
|
||||||
|
'calc
|
||||||
|
fVal = fPrc * fVol
|
||||||
|
aVal = fVal - bVal - pVal
|
||||||
|
aVol = fVol - (bVol + pVol)
|
||||||
|
|
||||||
|
If (bVol + pVol) = 0 Then
|
||||||
|
aPrc = 0
|
||||||
|
Else
|
||||||
|
'aPrc = fVal / fVol - ((bVal + pVal) / (bVol + pVol))
|
||||||
|
aPrc = fPrc - (bPrc + pPrc)
|
||||||
|
End If
|
||||||
|
'End If
|
||||||
|
|
||||||
|
Me.load_mbox_ann
|
||||||
|
|
||||||
|
'build json
|
||||||
|
Set adjust = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
||||||
|
adjust("scenario")("version") = "b20"
|
||||||
|
adjust("scenario")("iter") = handler.basis
|
||||||
|
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
adjust("user") = Application.UserName
|
||||||
|
adjust("source") = "adj"
|
||||||
|
adjust("version") = "b20"
|
||||||
|
|
||||||
|
If opEditSales Then
|
||||||
|
If opPlugVol Then
|
||||||
|
adjust("type") = "scale_v"
|
||||||
|
adjust("amount") = aVal
|
||||||
|
Else
|
||||||
|
adjust("type") = "scale_p"
|
||||||
|
adjust("amount") = aVal
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
If aVol = 0 Then
|
||||||
|
adjust("type") = "scale_p"
|
||||||
|
Else
|
||||||
|
adjust("type") = "scale_vp"
|
||||||
|
End If
|
||||||
|
adjust("qty") = aVol
|
||||||
|
adjust("amount") = aVal
|
||||||
|
End If
|
||||||
|
|
||||||
|
'print json
|
||||||
|
tbAPI = JsonConverter.ConvertToJson(adjust)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Sub calc_mval()
|
||||||
|
|
||||||
|
Dim pchange As Double
|
||||||
|
Dim j As Object
|
||||||
|
|
||||||
|
If IsNumeric(tbMFVal.value) Then
|
||||||
|
'get textbox value
|
||||||
|
fValm = tbMFVal.value
|
||||||
|
'do calculations
|
||||||
|
aValm = fValm - bValm - pValm
|
||||||
|
|
||||||
|
'---------if volume adjustment method is selected, scale the volume up----------------------------------
|
||||||
|
If nomonth Then
|
||||||
|
fVolm = fValm / bPrcm
|
||||||
|
fPrcm = bPrcm
|
||||||
|
Else
|
||||||
|
If opmvol Then
|
||||||
|
pchange = fValm / (pValm + bValm)
|
||||||
|
fVolm = (pVolm + bVolm) * pchange
|
||||||
|
Else
|
||||||
|
fVolm = pVolm + bVolm
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
If fVolm = 0 Then
|
||||||
|
fPrcm = 0
|
||||||
|
Else
|
||||||
|
fPrcm = fValm / fVolm
|
||||||
|
End If
|
||||||
|
aVolm = fVolm - (bVolm + pVolm)
|
||||||
|
aPrcm = fPrcm - (bPrcm + pPrcm)
|
||||||
|
Else
|
||||||
|
aVolm = fVolm - bVolm - pVolm
|
||||||
|
aPrcm = 0
|
||||||
|
End If
|
||||||
|
tbMFVal = Format(tbMFVal, "#,###")
|
||||||
|
|
||||||
|
'build json
|
||||||
|
|
||||||
|
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
||||||
|
j("scenario")("version") = "b20"
|
||||||
|
j("scenario")("iter") = handler.basis
|
||||||
|
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
j("user") = Application.UserName
|
||||||
|
j("source") = "adj"
|
||||||
|
If opEditSalesM Then
|
||||||
|
If opmvol Then
|
||||||
|
If nomonth Then
|
||||||
|
j("type") = "addmonth_v"
|
||||||
|
j("month") = month(mline, 0)
|
||||||
|
Else
|
||||||
|
j("type") = "scale_v"
|
||||||
|
j("scenario")("order_month") = month(mline, 0)
|
||||||
|
End If
|
||||||
|
j("amount") = aValm
|
||||||
|
Else
|
||||||
|
If nomonth Then
|
||||||
|
j("type") = "addmonth_p"
|
||||||
|
j("month") = month(mline, 0)
|
||||||
|
Else
|
||||||
|
j("type") = "scale_p"
|
||||||
|
j("scenario")("order_month") = month(mline, 0)
|
||||||
|
End If
|
||||||
|
j("amount") = aValm
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
If nomonth Then
|
||||||
|
j("type") = "addmonth_vp"
|
||||||
|
j("month") = month(mline, 0)
|
||||||
|
Else
|
||||||
|
j("type") = "scale_vp"
|
||||||
|
j("scenario")("order_month") = month(mline, 0)
|
||||||
|
End If
|
||||||
|
j("qty") = aVolm
|
||||||
|
j("amount") = aValm
|
||||||
|
End If
|
||||||
|
|
||||||
|
month(mline, 10) = JsonConverter.ConvertToJson(j)
|
||||||
|
tbAPI = JsonConverter.ConvertToJson(j)
|
||||||
|
|
||||||
|
Me.load_mbox
|
||||||
|
Me.load_array
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub calc_mprice()
|
||||||
|
|
||||||
|
Dim j As Object
|
||||||
|
|
||||||
|
If IsNumeric(tbMFPrice.value) And tbMFPrice.value <> 0 And IsNumeric(tbMFVol.value) And tbMFVol.value <> 0 Then
|
||||||
|
'capture currently changed item
|
||||||
|
fVolm = tbMFVol.value
|
||||||
|
fPrcm = tbMFPrice.value
|
||||||
|
'calc
|
||||||
|
fValm = fPrcm * fVolm
|
||||||
|
aValm = fValm - bValm - pValm
|
||||||
|
aVolm = fVolm - (bVolm + pVolm)
|
||||||
|
If nomonth Then
|
||||||
|
aPrcm = fValm / fVolm - bPrcm
|
||||||
|
Else
|
||||||
|
aPrcm = fValm / fVolm - ((bValm + pValm) / (bVolm + pVolm))
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
fValm = 0
|
||||||
|
aValm = fValm - bValm - pValm
|
||||||
|
End If
|
||||||
|
|
||||||
|
'build json
|
||||||
|
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
||||||
|
j("scenario")("version") = "b20"
|
||||||
|
j("scenario")("iter") = handler.basis
|
||||||
|
j("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
j("user") = Application.UserName
|
||||||
|
j("source") = "adj"
|
||||||
|
If opEditSalesM Then
|
||||||
|
If opmvol Then
|
||||||
|
If nomonth Then
|
||||||
|
j("type") = "addmonth_v"
|
||||||
|
j("month") = month(mline, 0)
|
||||||
|
Else
|
||||||
|
j("type") = "scale_v"
|
||||||
|
j("scenario")("order_month") = month(mline, 0)
|
||||||
|
End If
|
||||||
|
j("amount") = aValm
|
||||||
|
Else
|
||||||
|
If nomonth Then
|
||||||
|
'this scenario should be prevented
|
||||||
|
j("type") = "addmonth_v"
|
||||||
|
j("month") = month(mline, 0)
|
||||||
|
Else
|
||||||
|
j("type") = "scale_p"
|
||||||
|
j("scenario")("order_month") = month(mline, 0)
|
||||||
|
End If
|
||||||
|
j("amount") = aValm
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
If nomonth Then
|
||||||
|
j("type") = "addmonth_vp"
|
||||||
|
j("month") = month(mline, 0)
|
||||||
|
Else
|
||||||
|
If aVolm = 0 Then
|
||||||
|
j("type") = "scale_p"
|
||||||
|
Else
|
||||||
|
j("type") = "scale_vp"
|
||||||
|
End If
|
||||||
|
j("scenario")("order_month") = month(mline, 0)
|
||||||
|
End If
|
||||||
|
j("qty") = aVolm
|
||||||
|
j("amount") = aValm
|
||||||
|
End If
|
||||||
|
|
||||||
|
month(mline, 10) = JsonConverter.ConvertToJson(j)
|
||||||
|
tbAPI = JsonConverter.ConvertToJson(j)
|
||||||
|
|
||||||
|
|
||||||
|
If clear_lb Then MsgBox ("clear")
|
||||||
|
Me.load_mbox
|
||||||
|
Me.load_array
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function iter_def(ByVal iter As String) As String
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
For i = 0 To UBound(handler.baseline)
|
||||||
|
If handler.baseline(i) = iter Then
|
||||||
|
iter_def = "baseline"
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
For i = 0 To UBound(handler.adjust)
|
||||||
|
If handler.adjust(i) = iter Then
|
||||||
|
iter_def = "adjust"
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
iter_def = "exclude"
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub new_part()
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
519
handler.bas
Normal file
519
handler.bas
Normal file
@ -0,0 +1,519 @@
|
|||||||
|
Attribute VB_Name = "handler"
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
Public sql As String
|
||||||
|
Public jsql As String
|
||||||
|
Public scenario As String
|
||||||
|
Public sc() As Variant
|
||||||
|
Public x As New TheBigOne
|
||||||
|
Public wapi As New Windows_API
|
||||||
|
Public data() As String
|
||||||
|
Public agg() As String
|
||||||
|
Public showprice As Boolean
|
||||||
|
Public server As String
|
||||||
|
Public basis() As Variant
|
||||||
|
Public baseline() As Variant
|
||||||
|
Public adjust() As Variant
|
||||||
|
|
||||||
|
|
||||||
|
Sub load_fpvt()
|
||||||
|
|
||||||
|
Application.StatusBar = "retrieving selection data....."
|
||||||
|
|
||||||
|
'data = x.SHTp_Get("data", 1, 1, True)
|
||||||
|
'Call x.TBLp_Aggregate(data, True, True, True, Array(1, 3), Array("S", "S"), Array(30))
|
||||||
|
Dim i As Long
|
||||||
|
Dim s_tot As Object
|
||||||
|
|
||||||
|
fpvt.ListBox1.list = handler.sc
|
||||||
|
|
||||||
|
showprice = False
|
||||||
|
|
||||||
|
For i = 0 To UBound(handler.sc, 1)
|
||||||
|
If handler.sc(i, 0) = "part_descr" Then
|
||||||
|
showprice = True
|
||||||
|
Exit For
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
|
||||||
|
fpvt.Show
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function scenario_package(doc As String, ByRef status As Boolean) As Object
|
||||||
|
|
||||||
|
Dim req As New WinHttp.WinHttpRequest
|
||||||
|
Dim json As Object
|
||||||
|
Dim wr As String
|
||||||
|
|
||||||
|
On Error GoTo errh
|
||||||
|
|
||||||
|
With req
|
||||||
|
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||||
|
.Open "GET", server & "/scenario_package", True
|
||||||
|
.SetRequestHeader "Content-Type", "application/json"
|
||||||
|
.Send doc
|
||||||
|
.WaitForResponse
|
||||||
|
wr = .ResponseText
|
||||||
|
End With
|
||||||
|
|
||||||
|
Set json = JsonConverter.ParseJson(wr)
|
||||||
|
Set scenario_package = json
|
||||||
|
|
||||||
|
errh:
|
||||||
|
If Err.Number <> 0 Then
|
||||||
|
status = False
|
||||||
|
MsgBox (Err.Description)
|
||||||
|
Set scenario_package = Nothing
|
||||||
|
Else
|
||||||
|
status = True
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub pg_main_workset(rep As String)
|
||||||
|
|
||||||
|
Dim req As New WinHttp.WinHttpRequest
|
||||||
|
Dim wapi As New Windows_API
|
||||||
|
Dim wr As String
|
||||||
|
Dim json As Object
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim doc As String
|
||||||
|
Dim res() As Variant
|
||||||
|
Dim str() 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
|
||||||
|
.WaitForResponse
|
||||||
|
wr = .ResponseText
|
||||||
|
End With
|
||||||
|
|
||||||
|
Set json = JsonConverter.ParseJson(wr)
|
||||||
|
ReDim res(json("x").Count, 32)
|
||||||
|
|
||||||
|
For i = 1 To UBound(res, 1)
|
||||||
|
res(i, 0) = json("x")(i)("bill_cust_descr")
|
||||||
|
res(i, 1) = json("x")(i)("billto_group")
|
||||||
|
res(i, 2) = json("x")(i)("ship_cust_descr")
|
||||||
|
res(i, 3) = json("x")(i)("shipto_group")
|
||||||
|
res(i, 4) = json("x")(i)("quota_rep_descr")
|
||||||
|
res(i, 5) = json("x")(i)("director_descr")
|
||||||
|
res(i, 6) = json("x")(i)("segm")
|
||||||
|
res(i, 7) = json("x")(i)("mod_chan")
|
||||||
|
res(i, 8) = json("x")(i)("mod_chansub")
|
||||||
|
res(i, 9) = json("x")(i)("majg_descr")
|
||||||
|
res(i, 10) = json("x")(i)("ming_descr")
|
||||||
|
res(i, 11) = json("x")(i)("majs_descr")
|
||||||
|
res(i, 12) = json("x")(i)("mins_descr")
|
||||||
|
res(i, 13) = json("x")(i)("brand")
|
||||||
|
res(i, 14) = json("x")(i)("part_family")
|
||||||
|
res(i, 15) = json("x")(i)("part_group")
|
||||||
|
res(i, 16) = json("x")(i)("branding")
|
||||||
|
res(i, 17) = json("x")(i)("color")
|
||||||
|
res(i, 18) = json("x")(i)("part_descr")
|
||||||
|
res(i, 19) = json("x")(i)("order_season")
|
||||||
|
res(i, 20) = json("x")(i)("order_month")
|
||||||
|
res(i, 21) = json("x")(i)("ship_season")
|
||||||
|
res(i, 22) = json("x")(i)("ship_month")
|
||||||
|
res(i, 23) = json("x")(i)("request_season")
|
||||||
|
res(i, 24) = json("x")(i)("request_month")
|
||||||
|
res(i, 25) = json("x")(i)("promo")
|
||||||
|
res(i, 26) = json("x")(i)("version")
|
||||||
|
res(i, 27) = json("x")(i)("iter")
|
||||||
|
res(i, 28) = json("x")(i)("value_loc")
|
||||||
|
res(i, 29) = json("x")(i)("value_usd")
|
||||||
|
res(i, 30) = json("x")(i)("cost_loc")
|
||||||
|
res(i, 31) = json("x")(i)("cost_usd")
|
||||||
|
res(i, 32) = json("x")(i)("units")
|
||||||
|
Next i
|
||||||
|
|
||||||
|
res(0, 0) = "bill_cust_descr"
|
||||||
|
res(0, 1) = "billto_group"
|
||||||
|
res(0, 2) = "ship_cust_descr"
|
||||||
|
res(0, 3) = "shipto_group"
|
||||||
|
res(0, 4) = "quota_rep_descr"
|
||||||
|
res(0, 5) = "director_descr"
|
||||||
|
res(0, 6) = "segm"
|
||||||
|
res(0, 7) = "mod_chan"
|
||||||
|
res(0, 8) = "mod_chansub"
|
||||||
|
res(0, 9) = "majg_descr"
|
||||||
|
res(0, 10) = "ming_descr"
|
||||||
|
res(0, 11) = "majs_descr"
|
||||||
|
res(0, 12) = "mins_descr"
|
||||||
|
res(0, 13) = "brand"
|
||||||
|
res(0, 14) = "part_family"
|
||||||
|
res(0, 15) = "part_group"
|
||||||
|
res(0, 16) = "branding"
|
||||||
|
res(0, 17) = "color"
|
||||||
|
res(0, 18) = "part_descr"
|
||||||
|
res(0, 19) = "order_season"
|
||||||
|
res(0, 20) = "order_month"
|
||||||
|
res(0, 21) = "ship_season"
|
||||||
|
res(0, 22) = "ship_month"
|
||||||
|
res(0, 23) = "request_season"
|
||||||
|
res(0, 24) = "request_month"
|
||||||
|
res(0, 25) = "promo"
|
||||||
|
res(0, 26) = "version"
|
||||||
|
res(0, 27) = "iter"
|
||||||
|
res(0, 28) = "value_loc"
|
||||||
|
res(0, 29) = "value_usd"
|
||||||
|
res(0, 30) = "cost_loc"
|
||||||
|
res(0, 31) = "cost_usd"
|
||||||
|
res(0, 32) = "units"
|
||||||
|
|
||||||
|
Set json = Nothing
|
||||||
|
|
||||||
|
ReDim str(UBound(res, 1), UBound(res, 2))
|
||||||
|
|
||||||
|
Worksheets("data").Cells.ClearContents
|
||||||
|
Call x.SHTp_DumpVar(res, "data", 1, 1, False, True, True)
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub pull_rep()
|
||||||
|
|
||||||
|
openf.Show
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Function request_adjust(doc As String, ByRef fail As Boolean) As Object
|
||||||
|
|
||||||
|
Dim req As New WinHttp.WinHttpRequest
|
||||||
|
Dim json As Object
|
||||||
|
Dim wr As String
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim str() As String
|
||||||
|
|
||||||
|
If doc = "" Then
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
'update timestamp
|
||||||
|
Set json = JsonConverter.ParseJson(doc)
|
||||||
|
'json("stamp") = Format(Now, "yyyy-mm-dd hh:mm:ss")
|
||||||
|
'doc = JsonConverter.ConvertToJson(doc)
|
||||||
|
|
||||||
|
server = Sheets("config").Cells(1, 2)
|
||||||
|
|
||||||
|
With req
|
||||||
|
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||||
|
.Open "POST", server & "/" & json("type"), True
|
||||||
|
.SetRequestHeader "Content-Type", "application/json"
|
||||||
|
.Send doc
|
||||||
|
.WaitForResponse
|
||||||
|
wr = .ResponseText
|
||||||
|
End With
|
||||||
|
|
||||||
|
If Mid(wr, 2, 5) = "error" Then
|
||||||
|
MsgBox (wr)
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Mid(wr, 1, 6) = "<body>" Then
|
||||||
|
MsgBox (wr)
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Mid(wr, 1, 6) = "<!DOCT" Then
|
||||||
|
MsgBox (wr)
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
Set json = JsonConverter.ParseJson(wr)
|
||||||
|
|
||||||
|
If IsNull(json("x")) Then
|
||||||
|
MsgBox ("no adjustment was made")
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
ReDim res(json("x").Count - 1, 32)
|
||||||
|
|
||||||
|
For i = 1 To UBound(res, 1) + 1
|
||||||
|
res(i - 1, 0) = json("x")(i)("bill_cust_descr")
|
||||||
|
res(i - 1, 1) = json("x")(i)("billto_group")
|
||||||
|
res(i - 1, 2) = json("x")(i)("ship_cust_descr")
|
||||||
|
res(i - 1, 3) = json("x")(i)("shipto_group")
|
||||||
|
res(i - 1, 4) = json("x")(i)("quota_rep_descr")
|
||||||
|
res(i - 1, 5) = json("x")(i)("director_descr")
|
||||||
|
res(i - 1, 6) = json("x")(i)("segm")
|
||||||
|
res(i - 1, 7) = json("x")(i)("mod_chan")
|
||||||
|
res(i - 1, 8) = json("x")(i)("mod_chansub")
|
||||||
|
res(i - 1, 9) = json("x")(i)("majg_descr")
|
||||||
|
res(i - 1, 10) = json("x")(i)("ming_descr")
|
||||||
|
res(i - 1, 11) = json("x")(i)("majs_descr")
|
||||||
|
res(i - 1, 12) = json("x")(i)("mins_descr")
|
||||||
|
res(i - 1, 13) = json("x")(i)("brand")
|
||||||
|
res(i - 1, 14) = json("x")(i)("part_family")
|
||||||
|
res(i - 1, 15) = json("x")(i)("part_group")
|
||||||
|
res(i - 1, 16) = json("x")(i)("branding")
|
||||||
|
res(i - 1, 17) = json("x")(i)("color")
|
||||||
|
res(i - 1, 18) = json("x")(i)("part_descr")
|
||||||
|
res(i - 1, 19) = json("x")(i)("order_season")
|
||||||
|
res(i - 1, 20) = json("x")(i)("order_month")
|
||||||
|
res(i - 1, 21) = json("x")(i)("ship_season")
|
||||||
|
res(i - 1, 22) = json("x")(i)("ship_month")
|
||||||
|
res(i - 1, 23) = json("x")(i)("request_season")
|
||||||
|
res(i - 1, 24) = json("x")(i)("request_month")
|
||||||
|
res(i - 1, 25) = json("x")(i)("promo")
|
||||||
|
res(i - 1, 26) = json("x")(i)("version")
|
||||||
|
res(i - 1, 27) = json("x")(i)("iter")
|
||||||
|
res(i - 1, 28) = json("x")(i)("value_loc")
|
||||||
|
res(i - 1, 29) = json("x")(i)("value_usd")
|
||||||
|
res(i - 1, 30) = json("x")(i)("cost_loc")
|
||||||
|
res(i - 1, 31) = json("x")(i)("cost_usd")
|
||||||
|
res(i - 1, 32) = json("x")(i)("units")
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Set json = Nothing
|
||||||
|
|
||||||
|
ReDim str(UBound(res, 1), UBound(res, 2))
|
||||||
|
|
||||||
|
' For i = 0 To UBound(res, 1)
|
||||||
|
' For j = 0 To UBound(res, 2)
|
||||||
|
' If IsNull(res(i, j)) Then
|
||||||
|
' str(i, j) = ""
|
||||||
|
' Else
|
||||||
|
' str(i, j) = res(i, j)
|
||||||
|
' End If
|
||||||
|
' Next j
|
||||||
|
' Next i
|
||||||
|
|
||||||
|
i = 1
|
||||||
|
Do Until Sheets("data").Cells(i, 1) = ""
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
|
||||||
|
Call x.SHTp_DumpVar(res, "data", i, 1, False, False, True)
|
||||||
|
|
||||||
|
|
||||||
|
'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32)
|
||||||
|
|
||||||
|
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub load_config()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
Dim j As Integer
|
||||||
|
'----server to use---------------------------------------------------------
|
||||||
|
handler.server = Sheets("config").Cells(1, 2)
|
||||||
|
'---basis-----------------------------------------------------------------
|
||||||
|
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)
|
||||||
|
'---baseline-----------------------------------------------------------------
|
||||||
|
ReDim handler.baseline(100)
|
||||||
|
i = 2
|
||||||
|
j = 0
|
||||||
|
Do While Sheets("config").Cells(3, i) <> ""
|
||||||
|
handler.baseline(j) = Sheets("config").Cells(3, i)
|
||||||
|
j = j + 1
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
ReDim Preserve handler.baseline(j - 1)
|
||||||
|
'---adjustments-----------------------------------------------------------------
|
||||||
|
ReDim handler.adjust(100)
|
||||||
|
i = 2
|
||||||
|
j = 0
|
||||||
|
Do While Sheets("config").Cells(4, i) <> ""
|
||||||
|
handler.adjust(j) = Sheets("config").Cells(4, i)
|
||||||
|
j = j + 1
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
ReDim Preserve handler.adjust(j - 1)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub month_tosheet(ByRef pkg() As Variant, ByRef basket() As Variant)
|
||||||
|
|
||||||
|
Dim j As Object
|
||||||
|
Dim i As Integer
|
||||||
|
Dim r As Long
|
||||||
|
Dim sh As Worksheet
|
||||||
|
Set sh = Sheets("_month")
|
||||||
|
|
||||||
|
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
|
||||||
|
sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
|
||||||
|
|
||||||
|
For i = 0 To 12
|
||||||
|
'------------volume-------------------
|
||||||
|
sh.Cells(i + 1, 1) = co_num(pkg(i, 1), 0)
|
||||||
|
sh.Cells(i + 1, 2) = co_num(pkg(i, 2), 0)
|
||||||
|
sh.Cells(i + 1, 3) = co_num(pkg(i, 3), 0)
|
||||||
|
sh.Cells(i + 1, 4) = 0
|
||||||
|
sh.Cells(i + 1, 5) = co_num(pkg(i, 4), 0)
|
||||||
|
|
||||||
|
'------------value----------------------
|
||||||
|
sh.Cells(i + 1, 11) = co_num(pkg(i, 5), 0)
|
||||||
|
sh.Cells(i + 1, 12) = co_num(pkg(i, 6), 0)
|
||||||
|
sh.Cells(i + 1, 13) = co_num(pkg(i, 7), 0)
|
||||||
|
sh.Cells(i + 1, 14) = 0
|
||||||
|
sh.Cells(i + 1, 15) = co_num(pkg(i, 8), 0)
|
||||||
|
|
||||||
|
'-------------price----------------------
|
||||||
|
If i > 0 Then
|
||||||
|
'--prior--
|
||||||
|
If co_num(pkg(i, 1), 0) = 0 Then
|
||||||
|
sh.Cells(i + 1, 6) = 0
|
||||||
|
Else
|
||||||
|
sh.Cells(i + 1, 6) = pkg(i, 5) / pkg(i, 1)
|
||||||
|
End If
|
||||||
|
|
||||||
|
'--base--
|
||||||
|
If co_num(pkg(i, 2), 0) = 0 Then
|
||||||
|
'if there is no monthly base volume,
|
||||||
|
'then use the prior price, if there was no prior price,
|
||||||
|
'then inherit the average price for the year before current adjustments
|
||||||
|
If sh.Cells(i, 7) <> 0 Then
|
||||||
|
sh.Cells(i + 1, 7) = sh.Cells(i, 7)
|
||||||
|
Else
|
||||||
|
If pkg(13, 1) + pkg(13, 2) = 0 Then
|
||||||
|
sh.Cells(i + 1, 7) = 0
|
||||||
|
Else
|
||||||
|
sh.Cells(i + 1, 7) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
sh.Cells(i + 1, 7) = pkg(i, 6) / pkg(i, 2)
|
||||||
|
End If
|
||||||
|
|
||||||
|
'--adjust--
|
||||||
|
If (pkg(i, 3) + pkg(i, 2)) = 0 Or 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
|
||||||
|
|
||||||
|
'--current adjust--
|
||||||
|
sh.Cells(i + 1, 9) = 0
|
||||||
|
|
||||||
|
'--forecast--
|
||||||
|
If co_num(pkg(i, 4), 0) = 0 Then
|
||||||
|
'if there is no monthly base volume,
|
||||||
|
'then use the prior price, if there was no prior price,
|
||||||
|
'then inherit the average price for the year before current adjustments
|
||||||
|
If sh.Cells(i, 10) <> 0 Then
|
||||||
|
sh.Cells(i + 1, 10) = sh.Cells(i, 10)
|
||||||
|
Else
|
||||||
|
If pkg(13, 1) + pkg(13, 2) = 0 Then
|
||||||
|
sh.Cells(i + 1, 10) = 0
|
||||||
|
Else
|
||||||
|
sh.Cells(i + 1, 10) = (pkg(13, 5) + pkg(13, 6)) / (pkg(13, 1) + pkg(13, 2))
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
sh.Cells(i + 1, 10) = pkg(i, 8) / pkg(i, 4)
|
||||||
|
End If
|
||||||
|
|
||||||
|
End If
|
||||||
|
|
||||||
|
Next i
|
||||||
|
|
||||||
|
'scenario
|
||||||
|
Sheets("_month").Range("R1:S1000").ClearContents
|
||||||
|
For i = 0 To UBound(handler.sc, 1)
|
||||||
|
sh.Cells(i + 1, 18) = handler.sc(i, 0)
|
||||||
|
sh.Cells(i + 1, 19) = handler.sc(i, 1)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
'basket
|
||||||
|
sh.Range("U1:AC100000").ClearContents
|
||||||
|
Call x.SHTp_DumpVar(basket, "_month", 1, 21, False, False, True)
|
||||||
|
Call x.SHTp_DumpVar(basket, "_month", 1, 26, False, False, True)
|
||||||
|
Sheets("config").Cells(5, 2) = 0
|
||||||
|
Sheets("config").Cells(6, 2) = 0
|
||||||
|
Sheets("config").Cells(7, 2) = 0
|
||||||
|
|
||||||
|
months.load_sheet
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant
|
||||||
|
|
||||||
|
If one = "" Or IsNull(one) Then
|
||||||
|
co_num = two
|
||||||
|
Else
|
||||||
|
co_num = one
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
|
||||||
|
|
||||||
|
Dim req As New WinHttp.WinHttpRequest
|
||||||
|
Dim json As Object
|
||||||
|
Dim wr As String
|
||||||
|
Dim i As Integer
|
||||||
|
Dim j As Integer
|
||||||
|
Dim res() As Variant
|
||||||
|
|
||||||
|
If doc = "" Then
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
server = Sheets("config").Cells(1, 2)
|
||||||
|
|
||||||
|
With req
|
||||||
|
.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = SslErrorFlag_Ignore_All
|
||||||
|
.Open "GET", server & "/list_changes", True
|
||||||
|
.SetRequestHeader "Content-Type", "application/json"
|
||||||
|
.Send doc
|
||||||
|
.WaitForResponse
|
||||||
|
wr = .ResponseText
|
||||||
|
End With
|
||||||
|
|
||||||
|
Set json = JsonConverter.ParseJson(wr)
|
||||||
|
|
||||||
|
If IsNull(json("x")) Then
|
||||||
|
MsgBox ("no history")
|
||||||
|
fail = True
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
ReDim res(json("x").Count - 1, 5)
|
||||||
|
|
||||||
|
For i = 0 To UBound(res, 1)
|
||||||
|
res(i, 0) = json("x")(i + 1)("user")
|
||||||
|
res(i, 1) = json("x")(i + 1)("stamp")
|
||||||
|
res(i, 2) = json("x")(i + 1)("comment")
|
||||||
|
res(i, 3) = json("x")(i + 1)("sales")
|
||||||
|
res(i, 4) = json("x")(i + 1)("def")
|
||||||
|
Next i
|
||||||
|
|
||||||
|
list_changes = res
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Sub history()
|
||||||
|
|
||||||
|
changes.Show
|
||||||
|
|
||||||
|
End Sub
|
35
login.frm
Normal file
35
login.frm
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} login
|
||||||
|
Caption = "CMS Login"
|
||||||
|
ClientHeight = 2295
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 2445
|
||||||
|
OleObjectBlob = "login.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "login"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Public proceed As Boolean
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbCANCEL_Click()
|
||||||
|
tbU.Text = ""
|
||||||
|
tbP.Text = ""
|
||||||
|
proceed = False
|
||||||
|
Me.Hide
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub cbOK_Click()
|
||||||
|
proceed = True
|
||||||
|
Me.Hide
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub UserForm_Terminate()
|
||||||
|
proceed = False
|
||||||
|
End Sub
|
963
months.cls
Normal file
963
months.cls
Normal file
@ -0,0 +1,963 @@
|
|||||||
|
VERSION 1.0 CLASS
|
||||||
|
BEGIN
|
||||||
|
MultiUse = -1 'True
|
||||||
|
END
|
||||||
|
Attribute VB_Name = "months"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = True
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
Private x As New TheBigOne
|
||||||
|
Private units() As Variant
|
||||||
|
Private price() As Variant
|
||||||
|
Private sales() As Variant
|
||||||
|
Private tunits() As Variant
|
||||||
|
Private tprice() As Variant
|
||||||
|
Private tsales() As Variant
|
||||||
|
Private dumping As Boolean
|
||||||
|
Private vedit As String
|
||||||
|
Private adjust() As Object
|
||||||
|
Private jtext() As Variant
|
||||||
|
Private basejson As Object
|
||||||
|
Private rollback As Boolean
|
||||||
|
Private scenario() As Variant
|
||||||
|
Private orig As Range
|
||||||
|
Private basket_touch As Range
|
||||||
|
Private showbasket As Boolean
|
||||||
|
Private np As Object 'json dedicated to new part scenario
|
||||||
|
Private b() As Variant 'holds basket
|
||||||
|
|
||||||
|
Private Sub Worksheet_Change(ByVal target As Range)
|
||||||
|
|
||||||
|
If Not dumping Then
|
||||||
|
|
||||||
|
If Not Intersect(target, Range("A1:R18")) Is Nothing Then
|
||||||
|
If target.Columns.Count > 1 Then
|
||||||
|
MsgBox ("you can only change one column at a time - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Not Intersect(target, Range("E6:E17")) Is Nothing Then Call Me.mvp_adj
|
||||||
|
If Not Intersect(target, Range("F6:F17")) Is Nothing Then Call Me.mvp_set
|
||||||
|
If Not Intersect(target, Range("K6:K17")) Is Nothing Then Call Me.mvp_adj
|
||||||
|
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 And Worksheets("config").Cells(6, 2) = 1 Then
|
||||||
|
Set basket_touch = target
|
||||||
|
Call Me.get_edit_basket
|
||||||
|
Set basket_touch = Nothing
|
||||||
|
End If
|
||||||
|
|
||||||
|
End If
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
|
||||||
|
|
||||||
|
|
||||||
|
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||||
|
cancel = True
|
||||||
|
Call Me.basket_pick(target)
|
||||||
|
target.Select
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Sub picker_shortcut()
|
||||||
|
|
||||||
|
If Not Intersect(Selection, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||||
|
Call Me.basket_pick(Selection)
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, cancel As Boolean)
|
||||||
|
|
||||||
|
If Not Intersect(target, Range("B33:Q1000")) Is Nothing And Worksheets("config").Cells(6, 2) = 1 Then
|
||||||
|
cancel = True
|
||||||
|
Call Me.basket_pick(target)
|
||||||
|
target.Select
|
||||||
|
End If
|
||||||
|
|
||||||
|
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 mvp_set()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
Call Me.get_sheet
|
||||||
|
|
||||||
|
For i = 1 To 12
|
||||||
|
If units(i, 5) = "" Then units(i, 5) = 0
|
||||||
|
If price(i, 5) = "" Then price(i, 5) = 0
|
||||||
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
||||||
|
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
||||||
|
sales(i, 5) = units(i, 5) * price(i, 5)
|
||||||
|
If units(i, 4) = 0 And price(i, 4) = 0 Then
|
||||||
|
sales(i, 4) = 0
|
||||||
|
Else
|
||||||
|
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Me.crunch_array
|
||||||
|
Me.build_json
|
||||||
|
Me.set_sheet
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub mvp_adj()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
Call Me.get_sheet
|
||||||
|
|
||||||
|
For i = 1 To 12
|
||||||
|
If units(i, 4) = "" Then units(i, 4) = 0
|
||||||
|
If price(i, 4) = "" Then price(i, 4) = 0
|
||||||
|
units(i, 5) = units(i, 4) + (units(i, 2) + units(i, 3))
|
||||||
|
price(i, 5) = price(i, 4) + (price(i, 2) + price(i, 3))
|
||||||
|
sales(i, 5) = units(i, 5) * price(i, 5)
|
||||||
|
If units(i, 4) = 0 And price(i, 4) = 0 Then
|
||||||
|
sales(i, 4) = 0
|
||||||
|
Else
|
||||||
|
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Me.crunch_array
|
||||||
|
Me.build_json
|
||||||
|
Me.set_sheet
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub ms_set()
|
||||||
|
|
||||||
|
On Error GoTo errh
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
Call Me.get_sheet
|
||||||
|
Dim vp As String
|
||||||
|
vp = Sheets("month").Range("Q2")
|
||||||
|
|
||||||
|
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)), 2) <> Round(sales(i, 4), 2) Then
|
||||||
|
sales(i, 4) = sales(i, 5) - (sales(i, 2) + sales(i, 3))
|
||||||
|
Select Case vp
|
||||||
|
Case "volume"
|
||||||
|
If co_num(price(i, 5), 0) = 0 Then
|
||||||
|
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
'reset price to original - delete these lines if a cascading effect is desired
|
||||||
|
'price(i, 4) = 0
|
||||||
|
'price(i, 5) = price(i, 2) + price(i, 3)
|
||||||
|
'calc volume change on original price
|
||||||
|
units(i, 5) = sales(i, 5) / price(i, 5)
|
||||||
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
||||||
|
Case "price"
|
||||||
|
If co_num(units(i, 5), 0) = 0 Then
|
||||||
|
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
price(i, 5) = sales(i, 5) / units(i, 5)
|
||||||
|
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
||||||
|
Case Else
|
||||||
|
MsgBox ("error forcing sales with no offset specified - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End Select
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Me.crunch_array
|
||||||
|
Me.build_json
|
||||||
|
Me.set_sheet
|
||||||
|
|
||||||
|
errh:
|
||||||
|
If Err.Number <> 0 Then rollback = True
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub ms_adj()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
Call Me.get_sheet
|
||||||
|
Dim vp As String
|
||||||
|
vp = Sheets("month").Range("Q2")
|
||||||
|
|
||||||
|
For i = 1 To 12
|
||||||
|
If sales(i, 4) = "" Then sales(i, 4) = 0
|
||||||
|
If Round(sales(i, 5), 6) <> Round(sales(i, 2) + sales(i, 3) + sales(i, 4), 6) Then
|
||||||
|
sales(i, 5) = sales(i, 4) + sales(i, 2) + sales(i, 3)
|
||||||
|
Select Case vp
|
||||||
|
Case "volume"
|
||||||
|
If co_num(price(i, 5), 0) = 0 Then
|
||||||
|
MsgBox ("price cannot be -0- and also have sales - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
'reset price to original
|
||||||
|
'price(i, 4) = 0
|
||||||
|
'price(i, 5) = price(i, 2) + price(i, 3)
|
||||||
|
'calc volume change on original price
|
||||||
|
units(i, 5) = sales(i, 5) / price(i, 5)
|
||||||
|
units(i, 4) = units(i, 5) - (units(i, 2) + units(i, 3))
|
||||||
|
Case "price"
|
||||||
|
If co_num(units(i, 5), 0) = 0 Then
|
||||||
|
MsgBox ("volume cannot be -0- and also have sales - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
price(i, 5) = sales(i, 5) / units(i, 5)
|
||||||
|
price(i, 4) = price(i, 5) - (price(i, 2) + price(i, 3))
|
||||||
|
Case Else
|
||||||
|
MsgBox ("error forcing sales with no offset specified - your change will be undone")
|
||||||
|
dumping = True
|
||||||
|
Application.Undo
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End Select
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Me.crunch_array
|
||||||
|
Me.build_json
|
||||||
|
Me.set_sheet
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Sub get_sheet()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
units = Range("B6:F17")
|
||||||
|
price = Range("H6:L17")
|
||||||
|
sales = Range("N6:R17")
|
||||||
|
tunits = Range("B18:F18")
|
||||||
|
tprice = Range("H18:L18")
|
||||||
|
tsales = Range("N18:R18")
|
||||||
|
ReDim adjust(12)
|
||||||
|
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub set_sheet()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
dumping = True
|
||||||
|
|
||||||
|
Range("B6:F17") = units
|
||||||
|
Range("H6:L17") = price
|
||||||
|
Range("N6:R17") = sales
|
||||||
|
Range("B18:F18").FormulaR1C1 = tunits
|
||||||
|
Range("H18:L18").FormulaR1C1 = tprice
|
||||||
|
Range("N18:R18").FormulaR1C1 = tsales
|
||||||
|
Range("T6:U18").ClearContents
|
||||||
|
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
||||||
|
'Sheets("month").Range("B32:Q5000").ClearContents
|
||||||
|
|
||||||
|
If Me.newpart Then
|
||||||
|
Sheets("_month").Range("P2:P13").ClearContents
|
||||||
|
Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
|
||||||
|
Else
|
||||||
|
For i = 1 To 12
|
||||||
|
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
dumping = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub load_sheet()
|
||||||
|
|
||||||
|
units = Sheets("_month").Range("A2:E13").FormulaR1C1
|
||||||
|
price = Sheets("_month").Range("F2:J13").FormulaR1C1
|
||||||
|
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
|
||||||
|
scenario = Sheets("_month").Range("R1:S13").FormulaR1C1
|
||||||
|
tunits = Range("B18:F18")
|
||||||
|
tprice = Range("H18:L18")
|
||||||
|
tsales = Range("N18:R18")
|
||||||
|
'reset basket
|
||||||
|
Sheets("_month").Range("U1:X10000").ClearContents
|
||||||
|
Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("Z1")), "_month", 1, 21, False, False, False)
|
||||||
|
ReDim adjust(12)
|
||||||
|
Call Me.crunch_array
|
||||||
|
Call Me.set_sheet
|
||||||
|
Call Me.print_basket
|
||||||
|
Call Me.set_format
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub set_format()
|
||||||
|
|
||||||
|
Dim prices As Range
|
||||||
|
Dim price_adj As Range
|
||||||
|
Dim price_set As Range
|
||||||
|
Dim vol As Range
|
||||||
|
Dim vol_adj As Range
|
||||||
|
Dim vol_set As Range
|
||||||
|
Dim val As Range
|
||||||
|
Dim val_adj As Range
|
||||||
|
Dim val_set As Range
|
||||||
|
|
||||||
|
Set prices = Sheets("month").Range("H6:L17")
|
||||||
|
Set price_adj = Sheets("month").Range("K6:K17")
|
||||||
|
Set price_set = Sheets("month").Range("L6:L17")
|
||||||
|
|
||||||
|
Set vol = Sheets("month").Range("B6:F17")
|
||||||
|
Set vol_adj = Sheets("month").Range("E6:E17")
|
||||||
|
Set vol_set = Sheets("month").Range("F6:F17")
|
||||||
|
|
||||||
|
Set val = Sheets("month").Range("N6:R17")
|
||||||
|
Set val_adj = Sheets("month").Range("Q6:Q17")
|
||||||
|
Set val_set = Sheets("month").Range("R6:R17")
|
||||||
|
|
||||||
|
Call Me.format_price(prices)
|
||||||
|
Call Me.set_border(prices)
|
||||||
|
Call Me.fill_yellow(price_adj)
|
||||||
|
Call Me.fill_none(price_set)
|
||||||
|
|
||||||
|
Call Me.format_number(vol)
|
||||||
|
Call Me.set_border(vol)
|
||||||
|
Call Me.fill_yellow(vol_adj)
|
||||||
|
Call Me.fill_none(vol_set)
|
||||||
|
|
||||||
|
Call Me.format_number(val)
|
||||||
|
Call Me.set_border(val)
|
||||||
|
Call Me.fill_yellow(val_adj)
|
||||||
|
Call Me.fill_none(val_set)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub set_border(ByRef targ As Range)
|
||||||
|
|
||||||
|
targ.Borders(xlDiagonalDown).LineStyle = xlNone
|
||||||
|
targ.Borders(xlDiagonalUp).LineStyle = xlNone
|
||||||
|
With targ.Borders(xlEdgeLeft)
|
||||||
|
.LineStyle = xlContinuous
|
||||||
|
.ColorIndex = 0
|
||||||
|
.TintAndShade = 0
|
||||||
|
.Weight = xlThin
|
||||||
|
End With
|
||||||
|
With targ.Borders(xlEdgeTop)
|
||||||
|
.LineStyle = xlContinuous
|
||||||
|
.ColorIndex = 0
|
||||||
|
.TintAndShade = 0
|
||||||
|
.Weight = xlThin
|
||||||
|
End With
|
||||||
|
With targ.Borders(xlEdgeBottom)
|
||||||
|
.LineStyle = xlContinuous
|
||||||
|
.ColorIndex = 0
|
||||||
|
.TintAndShade = 0
|
||||||
|
.Weight = xlThin
|
||||||
|
End With
|
||||||
|
With targ.Borders(xlEdgeRight)
|
||||||
|
.LineStyle = xlContinuous
|
||||||
|
.ColorIndex = 0
|
||||||
|
.TintAndShade = 0
|
||||||
|
.Weight = xlThin
|
||||||
|
End With
|
||||||
|
With targ.Borders(xlInsideVertical)
|
||||||
|
.LineStyle = xlContinuous
|
||||||
|
.ColorIndex = 0
|
||||||
|
.TintAndShade = 0
|
||||||
|
.Weight = xlThin
|
||||||
|
End With
|
||||||
|
With targ.Borders(xlInsideHorizontal)
|
||||||
|
.LineStyle = xlContinuous
|
||||||
|
.ColorIndex = 0
|
||||||
|
.TintAndShade = 0
|
||||||
|
.Weight = xlThin
|
||||||
|
End With
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub fill_yellow(ByRef target As Range)
|
||||||
|
|
||||||
|
With target.Interior
|
||||||
|
.Pattern = xlSolid
|
||||||
|
.PatternColorIndex = xlAutomatic
|
||||||
|
.ThemeColor = xlThemeColorAccent4
|
||||||
|
.TintAndShade = 0.799981688894314
|
||||||
|
.PatternTintAndShade = 0
|
||||||
|
End With
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub fill_grey(ByRef target As Range)
|
||||||
|
|
||||||
|
|
||||||
|
With target.Interior
|
||||||
|
.Pattern = xlSolid
|
||||||
|
.PatternColorIndex = xlAutomatic
|
||||||
|
.ThemeColor = xlThemeColorDark1
|
||||||
|
.TintAndShade = -0.149998474074526
|
||||||
|
.PatternTintAndShade = 0
|
||||||
|
End With
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub fill_none(ByRef target As Range)
|
||||||
|
|
||||||
|
With target.Interior
|
||||||
|
.Pattern = xlNone
|
||||||
|
.TintAndShade = 0
|
||||||
|
.PatternTintAndShade = 0
|
||||||
|
End With
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub format_price(ByRef target As Range)
|
||||||
|
|
||||||
|
target.NumberFormat = "_(* #,##0.000_);_(* (#,##0.000);_(* ""-""???_);_(@_)"
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub format_number(ByRef target As Range)
|
||||||
|
|
||||||
|
target.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub build_json()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim pos As Long
|
||||||
|
Dim o As Object
|
||||||
|
Dim m As Object
|
||||||
|
Dim list As Object
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
ReDim adjust(12)
|
||||||
|
|
||||||
|
If Me.newpart Then
|
||||||
|
Set np = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
|
||||||
|
np("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
|
||||||
|
np("user") = Application.UserName
|
||||||
|
np("scenario")("version") = "b20"
|
||||||
|
Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
|
||||||
|
np("source") = "adj"
|
||||||
|
np("type") = "new_basket"
|
||||||
|
Set m = JsonConverter.ParseJson("{}")
|
||||||
|
End If
|
||||||
|
|
||||||
|
For pos = 1 To 12
|
||||||
|
If Me.newpart Then
|
||||||
|
If sales(pos, 5) <> 0 Then
|
||||||
|
Set o = JsonConverter.ParseJson("{}")
|
||||||
|
o("amount") = sales(pos, 5)
|
||||||
|
o("qty") = units(pos, 5)
|
||||||
|
Set m(Worksheets("month").Cells(5 + pos, 1).value) = JsonConverter.ParseJson(JsonConverter.ConvertToJson(o))
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
'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))
|
||||||
|
'if there is no existing volume on the target month but units are being added
|
||||||
|
If units(pos, 2) + units(pos, 3) = 0 And units(pos, 4) <> 0 Then
|
||||||
|
'add month
|
||||||
|
If Round(price(pos, 5), 8) <> Round(tprice(1, 2) + tprice(1, 3), 8) Then
|
||||||
|
'if the target price is diferent from the average and a month is being added
|
||||||
|
adjust(pos)("type") = "addmonth_vp"
|
||||||
|
Else
|
||||||
|
'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 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"
|
||||||
|
End If
|
||||||
|
adjust(pos)("qty") = units(pos, 4)
|
||||||
|
adjust(pos)("amount") = sales(pos, 4)
|
||||||
|
'------------add this in to only scale a particular month--------------------
|
||||||
|
adjust(pos)("scenario")("order_month") = Worksheets("month").Cells(5 + pos, 1)
|
||||||
|
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 If
|
||||||
|
Next pos
|
||||||
|
|
||||||
|
If Me.newpart Then
|
||||||
|
Set np("months") = JsonConverter.ParseJson(JsonConverter.ConvertToJson(m))
|
||||||
|
np("newpart") = Worksheets("month").Range("B33").value
|
||||||
|
'np("basket") = x.json_from_table(b, "basket", False)
|
||||||
|
'get the basket from the sheet
|
||||||
|
b = Worksheets("_month").Range("U1").CurrentRegion.value
|
||||||
|
Set m = JsonConverter.ParseJson(x.json_from_table(b, "basket", False))
|
||||||
|
If UBound(b, 1) <= 2 Then
|
||||||
|
Set np("basket") = JsonConverter.ParseJson("[" & x.json_from_table(b, "basket", False) & "]")
|
||||||
|
Else
|
||||||
|
Set np("basket") = m("basket")
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Me.newpart Then
|
||||||
|
Sheets("_month").Range("P2:P13").ClearContents
|
||||||
|
Sheets("_month").Cells(2, 16) = JsonConverter.ConvertToJson(np)
|
||||||
|
Else
|
||||||
|
For i = 1 To 12
|
||||||
|
Sheets("_month").Cells(i + 1, 16) = JsonConverter.ConvertToJson(adjust(i))
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub crunch_array()
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
Dim j As Integer
|
||||||
|
|
||||||
|
For i = 1 To 5
|
||||||
|
tunits(1, i) = 0
|
||||||
|
tprice(1, i) = 0
|
||||||
|
tsales(1, i) = 0
|
||||||
|
Next i
|
||||||
|
|
||||||
|
For i = 1 To 12
|
||||||
|
For j = 1 To 5
|
||||||
|
tunits(1, j) = tunits(1, j) + units(i, j)
|
||||||
|
tsales(1, j) = tsales(1, j) + sales(i, j)
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
|
||||||
|
'prior
|
||||||
|
If tunits(1, 1) = 0 Then
|
||||||
|
tprice(1, 1) = 0
|
||||||
|
Else
|
||||||
|
tprice(1, 1) = tsales(1, 1) / tunits(1, 1)
|
||||||
|
End If
|
||||||
|
'base
|
||||||
|
If tunits(1, 2) = 0 Then
|
||||||
|
tprice(1, 2) = 0
|
||||||
|
Else
|
||||||
|
tprice(1, 2) = tsales(1, 2) / tunits(1, 2)
|
||||||
|
End If
|
||||||
|
'forecast
|
||||||
|
If tunits(1, 5) <> 0 Then
|
||||||
|
tprice(1, 5) = tsales(1, 5) / tunits(1, 5)
|
||||||
|
Else
|
||||||
|
tprice(1, 5) = 0
|
||||||
|
End If
|
||||||
|
'adjust
|
||||||
|
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()
|
||||||
|
|
||||||
|
Sheets("Orders").Select
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub reset()
|
||||||
|
|
||||||
|
|
||||||
|
Call Me.load_sheet
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub switch_basket()
|
||||||
|
|
||||||
|
|
||||||
|
If Sheets("config").Cells(6, 2) = 1 Then
|
||||||
|
Sheets("config").Cells(6, 2) = 0
|
||||||
|
Else
|
||||||
|
Sheets("config").Cells(6, 2) = 1
|
||||||
|
End If
|
||||||
|
|
||||||
|
Call Me.print_basket
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub print_basket()
|
||||||
|
|
||||||
|
'Sheets("config").Cells(6, 2) = 1
|
||||||
|
If Sheets("config").Cells(6, 2) = 0 Then
|
||||||
|
dumping = True
|
||||||
|
Worksheets("month").Range("B32:Q10000").ClearContents
|
||||||
|
Rows("20:31").Hidden = False
|
||||||
|
dumping = False
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim basket() As Variant
|
||||||
|
basket = x.SHTp_get_block(Sheets("_month").Range("U1"))
|
||||||
|
|
||||||
|
dumping = True
|
||||||
|
|
||||||
|
Worksheets("month").Range("B32:Q10000").ClearContents
|
||||||
|
For i = 1 To UBound(basket, 1)
|
||||||
|
Sheets("month").Cells(31 + i, 2) = basket(i, 1)
|
||||||
|
Sheets("month").Cells(31 + i, 6) = basket(i, 2)
|
||||||
|
Sheets("month").Cells(31 + i, 12) = basket(i, 3)
|
||||||
|
Sheets("month").Cells(31 + i, 17) = basket(i, 4)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Rows("20:31").Hidden = True
|
||||||
|
|
||||||
|
dumping = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Sub basket_pick(ByRef target As Range)
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
|
||||||
|
|
||||||
|
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
|
||||||
|
Set basket_touch = Nothing
|
||||||
|
|
||||||
|
End If
|
||||||
|
target.Select
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub get_edit_basket()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim mix As Double
|
||||||
|
Dim touch_mix As Double
|
||||||
|
Dim untouched As Long
|
||||||
|
Dim touch() As Boolean
|
||||||
|
|
||||||
|
'ReDim b(basket_rows, 3)
|
||||||
|
|
||||||
|
i = 0
|
||||||
|
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
i = i - 1
|
||||||
|
|
||||||
|
ReDim b(i, 3)
|
||||||
|
ReDim touch(i)
|
||||||
|
untouched = i + 1
|
||||||
|
|
||||||
|
i = 0
|
||||||
|
mix = 0
|
||||||
|
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
||||||
|
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
|
||||||
|
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
|
||||||
|
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
|
||||||
|
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
|
||||||
|
If b(i, 3) = "" Then b(i, 3) = 0
|
||||||
|
mix = mix + b(i, 3)
|
||||||
|
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
|
||||||
|
|
||||||
|
'evaluate mix changes and force to 100
|
||||||
|
For i = 0 To UBound(b, 1)
|
||||||
|
If Not touch(i) Then
|
||||||
|
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
|
||||||
|
|
||||||
|
dumping = True
|
||||||
|
|
||||||
|
'put the mix plug back on the the sheet
|
||||||
|
For i = 0 To UBound(b, 1)
|
||||||
|
Worksheets("month").Cells(33 + i, 17) = b(i, 3)
|
||||||
|
Next i
|
||||||
|
|
||||||
|
dumping = False
|
||||||
|
|
||||||
|
Worksheets("_month").Range("U2:X5000").ClearContents
|
||||||
|
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
||||||
|
|
||||||
|
If Me.newpart Then
|
||||||
|
Me.build_json
|
||||||
|
End If
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Sub post_adjust()
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim fail As Boolean
|
||||||
|
|
||||||
|
If Me.newpart Then
|
||||||
|
Call handler.request_adjust(Sheets("_month").Cells(2, 16), fail)
|
||||||
|
If fail Then Exit Sub
|
||||||
|
Else
|
||||||
|
For i = 2 To 13
|
||||||
|
If Sheets("_month").Cells(i, 16) <> "" Then
|
||||||
|
Call handler.request_adjust(Sheets("_month").Cells(i, 16), fail)
|
||||||
|
If fail Then Exit Sub
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
End If
|
||||||
|
|
||||||
|
Sheets("Orders").Select
|
||||||
|
'Worksheets("month").Visible = xlHidden
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub build_new()
|
||||||
|
|
||||||
|
Worksheets("config").Cells(5, 2) = 1
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim basket() As Variant
|
||||||
|
Dim m() As Variant
|
||||||
|
|
||||||
|
dumping = True
|
||||||
|
|
||||||
|
m = Sheets("_month").Range("A2:O13").FormulaR1C1
|
||||||
|
|
||||||
|
For i = 1 To UBound(m, 1)
|
||||||
|
For j = 1 To UBound(m, 2)
|
||||||
|
m(i, j) = 0
|
||||||
|
Next j
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Worksheets("_month").Range("A2:O13") = m
|
||||||
|
|
||||||
|
Worksheets("_month").Range("U2:X1000").ClearContents
|
||||||
|
Worksheets("_month").Range("Z2:AC1000").ClearContents
|
||||||
|
Worksheets("_month").Range("R2:S1000").ClearContents
|
||||||
|
Call Me.load_sheet
|
||||||
|
'Call Me.set_sheet
|
||||||
|
'Call x.SHTp_DumpVar(x.SHTp_get_block(Worksheets("_month").Range("R1")), "month", 6, 20, False, False, False)
|
||||||
|
|
||||||
|
basket = x.SHTp_get_block(Worksheets("_month").Range("U1"))
|
||||||
|
Sheets("month").Cells(32, 2) = basket(1, 1)
|
||||||
|
Sheets("month").Cells(32, 6) = basket(1, 2)
|
||||||
|
Sheets("month").Cells(32, 12) = basket(1, 3)
|
||||||
|
Sheets("month").Cells(32, 17) = basket(1, 4)
|
||||||
|
Call Me.print_basket
|
||||||
|
|
||||||
|
dumping = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub new_part()
|
||||||
|
|
||||||
|
'keep customer mix
|
||||||
|
'add in new part number
|
||||||
|
'retain to _month
|
||||||
|
'set new part flag
|
||||||
|
|
||||||
|
Dim cust() As String
|
||||||
|
Dim i As Long
|
||||||
|
|
||||||
|
'---------build customer mix-------------------------------------------------------------------
|
||||||
|
|
||||||
|
cust = x.SHTp_Get("_month", 1, 27, True)
|
||||||
|
If Not x.TBLp_Aggregate(cust, True, True, True, Array(0, 1), Array("S", "S"), Array(2)) Then
|
||||||
|
MsgBox ("error building customer mix")
|
||||||
|
End If
|
||||||
|
|
||||||
|
'--------inquire for new part to join with cust mix--------------------------------------------
|
||||||
|
|
||||||
|
part.Show
|
||||||
|
|
||||||
|
If Not part.useval Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
dumping = True
|
||||||
|
|
||||||
|
Worksheets("month").Range("B33:Q10000").ClearContents
|
||||||
|
|
||||||
|
For i = 1 To UBound(cust, 2)
|
||||||
|
Sheets("month").Cells(32 + i, 2) = part.cbPart.value
|
||||||
|
Sheets("month").Cells(32 + i, 6) = cust(0, i)
|
||||||
|
Sheets("month").Cells(32 + i, 12) = cust(1, i)
|
||||||
|
Sheets("month").Cells(32 + i, 17) = CDbl(cust(2, i))
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Sheets("config").Cells(7, 2) = 1
|
||||||
|
|
||||||
|
'------copy revised basket to _month storage---------------------------------------------------
|
||||||
|
|
||||||
|
i = 0
|
||||||
|
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
i = i - 1
|
||||||
|
If i = -1 Then i = 0
|
||||||
|
ReDim b(i, 3)
|
||||||
|
i = 0
|
||||||
|
Do Until Worksheets("month").Cells(33 + i, 2) = ""
|
||||||
|
b(i, 0) = Worksheets("month").Cells(33 + i, 2)
|
||||||
|
b(i, 1) = Worksheets("month").Cells(33 + i, 6)
|
||||||
|
b(i, 2) = Worksheets("month").Cells(33 + i, 12)
|
||||||
|
b(i, 3) = Worksheets("month").Cells(33 + i, 17)
|
||||||
|
If b(i, 3) = "" Then b(i, 3) = 0
|
||||||
|
i = i + 1
|
||||||
|
Loop
|
||||||
|
Worksheets("_month").Range("U2:AC10000").ClearContents
|
||||||
|
Call x.SHTp_DumpVar(b, "_month", 2, 21, False, False, True)
|
||||||
|
Call x.SHTp_DumpVar(b, "_month", 2, 26, False, False, True)
|
||||||
|
|
||||||
|
'------reset volume to copy base to forecsat and clear base------------------------------------
|
||||||
|
|
||||||
|
units = Sheets("_month").Range("A2:E13").FormulaR1C1
|
||||||
|
price = Sheets("_month").Range("F2:J13").FormulaR1C1
|
||||||
|
sales = Sheets("_month").Range("K2:O13").FormulaR1C1
|
||||||
|
tunits = Range("B18:F18")
|
||||||
|
tprice = Range("H18:L18")
|
||||||
|
tsales = Range("N18:R18")
|
||||||
|
ReDim adjust(12)
|
||||||
|
Set basejson = JsonConverter.ParseJson(Sheets("_month").Range("P1").FormulaR1C1)
|
||||||
|
For i = 1 To 12
|
||||||
|
'volume
|
||||||
|
units(i, 5) = units(i, 2)
|
||||||
|
units(i, 4) = units(i, 2)
|
||||||
|
units(i, 1) = 0
|
||||||
|
units(i, 2) = 0
|
||||||
|
units(i, 3) = 0
|
||||||
|
'sales
|
||||||
|
sales(i, 5) = sales(i, 2)
|
||||||
|
sales(i, 4) = sales(i, 2)
|
||||||
|
sales(i, 1) = 0
|
||||||
|
sales(i, 2) = 0
|
||||||
|
sales(i, 3) = 0
|
||||||
|
'price
|
||||||
|
price(i, 5) = price(i, 2)
|
||||||
|
price(i, 4) = price(i, 2)
|
||||||
|
price(i, 1) = 0
|
||||||
|
price(i, 2) = 0
|
||||||
|
price(i, 3) = 0
|
||||||
|
Next i
|
||||||
|
Call Me.crunch_array
|
||||||
|
Call Me.build_json
|
||||||
|
Call Me.set_sheet
|
||||||
|
|
||||||
|
'-------------push revised arrays back to _month, not revertable-------------------------------
|
||||||
|
|
||||||
|
Worksheets("_month").Range("A2:E13") = units
|
||||||
|
Worksheets("_month").Range("F2:J13") = price
|
||||||
|
Worksheets("_month").Range("K2:o13") = sales
|
||||||
|
|
||||||
|
|
||||||
|
'force basket to show to demonstrate the part was changed
|
||||||
|
Sheets("config").Cells(6, 2) = 1
|
||||||
|
Call Me.print_basket
|
||||||
|
dumping = False
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function newpart() As Boolean
|
||||||
|
|
||||||
|
If Worksheets("config").Cells(7, 2) = 1 Then
|
||||||
|
newpart = True
|
||||||
|
Else
|
||||||
|
newpart = False
|
||||||
|
End If
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
51
openf.frm
Normal file
51
openf.frm
Normal file
@ -0,0 +1,51 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} openf
|
||||||
|
Caption = "Open a Forecast"
|
||||||
|
ClientHeight = 2025
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 3825
|
||||||
|
OleObjectBlob = "openf.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "openf"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Private Sub cbCancel_Click()
|
||||||
|
|
||||||
|
openf.Hide
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub cbOK_Click()
|
||||||
|
|
||||||
|
Application.StatusBar = "Retrieving data for " & cbDSM.value & "....."
|
||||||
|
|
||||||
|
openf.Caption = "retrieving data......"
|
||||||
|
Call handler.pg_main_workset(cbDSM.value)
|
||||||
|
Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh
|
||||||
|
Application.StatusBar = False
|
||||||
|
openf.Hide
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub UserForm_Activate()
|
||||||
|
|
||||||
|
'handler.server = "http://192.168.1.69:3000"
|
||||||
|
handler.server = Sheets("config").Cells(1, 2)
|
||||||
|
|
||||||
|
Dim x As New TheBigOne
|
||||||
|
Dim d() As String
|
||||||
|
|
||||||
|
openf.Caption = "Select a DSM"
|
||||||
|
d = x.SHTp_Get("reps", 1, 1, True)
|
||||||
|
|
||||||
|
For i = 1 To UBound(d, 2)
|
||||||
|
Call cbDSM.AddItem(d(0, i))
|
||||||
|
Next i
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
48
part.frm
Normal file
48
part.frm
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} part
|
||||||
|
Caption = "Part Picker"
|
||||||
|
ClientHeight = 1080
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 8100
|
||||||
|
OleObjectBlob = "part.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "part"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
|
||||||
|
Public part As String
|
||||||
|
Public bill As String
|
||||||
|
Public ship As String
|
||||||
|
Public useval As Boolean
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub cbPart_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
|
||||||
|
|
||||||
|
Select Case KeyCode
|
||||||
|
Case 13
|
||||||
|
useval = True
|
||||||
|
Me.Hide
|
||||||
|
Case 27
|
||||||
|
useval = False
|
||||||
|
Me.Hide
|
||||||
|
End Select
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub UserForm_Activate()
|
||||||
|
|
||||||
|
useval = False
|
||||||
|
|
||||||
|
cbPart.list = Application.transpose(Worksheets("mdata").Range("A2:A26267"))
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
107
pivot.bas
Normal file
107
pivot.bas
Normal file
@ -0,0 +1,107 @@
|
|||||||
|
VERSION 1.0 CLASS
|
||||||
|
BEGIN
|
||||||
|
MultiUse = -1 'True
|
||||||
|
END
|
||||||
|
Attribute VB_Name = "pivot"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = True
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
||||||
|
|
||||||
|
If Intersect(Target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
On Error GoTo nopiv
|
||||||
|
|
||||||
|
If Target.Cells.PivotTable Is Nothing Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Cancel = True
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim k As Long
|
||||||
|
|
||||||
|
Dim ri As PivotItemList
|
||||||
|
Dim ci As PivotItemList
|
||||||
|
Dim df As Object
|
||||||
|
Dim rd As Object
|
||||||
|
Dim cd As Object
|
||||||
|
Dim dd As Object
|
||||||
|
|
||||||
|
Dim pt As PivotTable
|
||||||
|
Dim pf As PivotField
|
||||||
|
Dim pi As PivotItem
|
||||||
|
Dim wapi As New Windows_API
|
||||||
|
|
||||||
|
Set ri = Target.Cells.PivotCell.RowItems
|
||||||
|
Set ci = Target.Cells.PivotCell.ColumnItems
|
||||||
|
Set df = Target.Cells.PivotCell.DataField
|
||||||
|
|
||||||
|
Set rd = Target.Cells.PivotTable.RowFields
|
||||||
|
Set cd = Target.Cells.PivotTable.ColumnFields
|
||||||
|
|
||||||
|
|
||||||
|
ReDim handler.sc(ri.Count, 1)
|
||||||
|
Set pt = Target.Cells.PivotCell.PivotTable
|
||||||
|
|
||||||
|
handler.sql = ""
|
||||||
|
handler.jsql = ""
|
||||||
|
|
||||||
|
For i = 1 To ri.Count
|
||||||
|
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
|
||||||
|
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
|
||||||
|
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & ri(i).Name & "'"
|
||||||
|
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & ri(i).Name & """"
|
||||||
|
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
|
||||||
|
handler.sc(i - 1, 1) = ri(i).Name
|
||||||
|
Next i
|
||||||
|
|
||||||
|
|
||||||
|
scenario = "{" & handler.jsql & "}"
|
||||||
|
|
||||||
|
Call handler.load_config
|
||||||
|
Call handler.load_fpvt
|
||||||
|
|
||||||
|
|
||||||
|
nopiv:
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function piv_pos(list As Object, target_pos As Long) As Long
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
|
||||||
|
For i = 1 To list.Count
|
||||||
|
If list(i).Position = target_pos Then
|
||||||
|
piv_pos = i
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
'should not get to this point
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
For i = 1 To pt.PivotFields.Count
|
||||||
|
If pt.PivotFields(i).Name = field_name Then
|
||||||
|
piv_fld_index = i
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
113
pivot.cls
Normal file
113
pivot.cls
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
VERSION 1.0 CLASS
|
||||||
|
BEGIN
|
||||||
|
MultiUse = -1 'True
|
||||||
|
END
|
||||||
|
Attribute VB_Name = "pivot"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = True
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
|
||||||
|
|
||||||
|
If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
On Error GoTo nopiv
|
||||||
|
|
||||||
|
If target.Cells.PivotTable Is Nothing Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
cancel = True
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim k As Long
|
||||||
|
|
||||||
|
Dim ri As PivotItemList
|
||||||
|
Dim ci As PivotItemList
|
||||||
|
Dim df As Object
|
||||||
|
Dim rd As Object
|
||||||
|
Dim cd As Object
|
||||||
|
Dim dd As Object
|
||||||
|
|
||||||
|
Dim pt As PivotTable
|
||||||
|
Dim pf As PivotField
|
||||||
|
Dim pi As PivotItem
|
||||||
|
Dim wapi As New Windows_API
|
||||||
|
|
||||||
|
Set ri = target.Cells.PivotCell.RowItems
|
||||||
|
Set ci = target.Cells.PivotCell.ColumnItems
|
||||||
|
Set df = target.Cells.PivotCell.DataField
|
||||||
|
|
||||||
|
Set rd = target.Cells.PivotTable.RowFields
|
||||||
|
Set cd = target.Cells.PivotTable.ColumnFields
|
||||||
|
|
||||||
|
ReDim handler.sc(ri.Count, 1)
|
||||||
|
Set pt = target.Cells.PivotCell.PivotTable
|
||||||
|
|
||||||
|
handler.sql = ""
|
||||||
|
handler.jsql = ""
|
||||||
|
|
||||||
|
For i = 1 To ri.Count
|
||||||
|
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
|
||||||
|
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
|
||||||
|
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape(ri(i).Name) & "'"
|
||||||
|
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape(ri(i).Name) & """"
|
||||||
|
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
|
||||||
|
handler.sc(i - 1, 1) = ri(i).Name
|
||||||
|
Next i
|
||||||
|
|
||||||
|
scenario = "{" & handler.jsql & "}"
|
||||||
|
|
||||||
|
Call handler.load_config
|
||||||
|
Call handler.load_fpvt
|
||||||
|
|
||||||
|
nopiv:
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Function piv_pos(list As Object, target_pos As Long) As Long
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
|
||||||
|
For i = 1 To list.Count
|
||||||
|
If list(i).Position = target_pos Then
|
||||||
|
piv_pos = i
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
'should not get to this point
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
|
||||||
|
|
||||||
|
Dim i As Integer
|
||||||
|
|
||||||
|
For i = 1 To pt.PivotFields.Count
|
||||||
|
If pt.PivotFields(i).Name = field_name Then
|
||||||
|
piv_fld_index = i
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Function escape(ByVal text As String) As String
|
||||||
|
|
||||||
|
text = Replace(text, "'", "''")
|
||||||
|
text = Replace(text, """", """""")
|
||||||
|
If text = "(blank)" Then text = ""
|
||||||
|
escape = text
|
||||||
|
|
||||||
|
End Function
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
48
pricelist.frm
Normal file
48
pricelist.frm
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
VERSION 5.00
|
||||||
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist
|
||||||
|
Caption = "Price List Name"
|
||||||
|
ClientHeight = 5115
|
||||||
|
ClientLeft = 120
|
||||||
|
ClientTop = 465
|
||||||
|
ClientWidth = 4110
|
||||||
|
OleObjectBlob = "pricelist.frx":0000
|
||||||
|
StartUpPosition = 1 'CenterOwner
|
||||||
|
End
|
||||||
|
Attribute VB_Name = "pricelist"
|
||||||
|
Attribute VB_GlobalNameSpace = False
|
||||||
|
Attribute VB_Creatable = False
|
||||||
|
Attribute VB_PredeclaredId = True
|
||||||
|
Attribute VB_Exposed = False
|
||||||
|
Public proceed As Boolean
|
||||||
|
|
||||||
|
Private Sub bCANCEL_Click()
|
||||||
|
proceed = False
|
||||||
|
Me.Hide
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub bOK_Click()
|
||||||
|
proceed = True
|
||||||
|
Me.Hide
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
Private Sub bPICK_Click()
|
||||||
|
|
||||||
|
'--------Open file-------------
|
||||||
|
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
|
||||||
|
fd.Show
|
||||||
|
|
||||||
|
tbPATH.Text = fd.SelectedItems(1)
|
||||||
|
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub UserForm_Initialize()
|
||||||
|
proceed = False
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub UserForm_Terminate()
|
||||||
|
proceed = False
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
BIN
pricelist.frx
Normal file
BIN
pricelist.frx
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user