lot of changes

This commit is contained in:
pt 2020-02-14 02:27:01 -05:00
parent 3c646b3a8d
commit 3932e224f0
10 changed files with 64 additions and 33 deletions

BIN
build.frx

Binary file not shown.

View File

@ -27,7 +27,7 @@ Private Sub lbHist_Change()
For i = 0 To Me.lbHist.ListCount - 1 For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then If Me.lbHist.Selected(i) Then
Me.tbPrint.value = x(i, 4) Me.tbPrint.value = x(i, 6)
Exit Sub Exit Sub
End If End If
Next i Next i
@ -42,7 +42,8 @@ Private Sub UserForm_Activate()
Dim fail As Boolean Dim fail As Boolean
x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail) 'x = handler.list_changes("{""user"":""" & Application.UserName & """}", fail)
x = handler.list_changes("{""quota_rep_descr"":""" & Sheets("data").Cells(2, 5) & """}", fail)
If fail Then If fail Then
Me.Hide Me.Hide
Exit Sub Exit Sub

Binary file not shown.

View File

@ -1,10 +1,10 @@
VERSION 5.00 VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt
Caption = "Forecast Adjustment" Caption = "Forecast Adjustment"
ClientHeight = 7350 ClientHeight = 8445.001
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 7110 ClientWidth = 8820.001
OleObjectBlob = "fpvt.frx":0000 OleObjectBlob = "fpvt.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -67,6 +67,10 @@ Private Sub butAdjust_Click()
Dim fail As Boolean Dim fail As Boolean
Dim com As String
com = InputBox("Enter any comments to describe the change")
Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail) Call handler.request_adjust(JsonConverter.ConvertToJson(adjust), fail)
If fail Then If fail Then
MsgBox ("adjustment was not made due to error") MsgBox ("adjustment was not made due to error")
@ -114,6 +118,10 @@ Private Sub cbGoSheet_Click()
End Sub End Sub
Private Sub Label64_Click()
End Sub
Private Sub lbMonth_Change() Private Sub lbMonth_Change()
If clear_lb Or load_tb Then Exit Sub If clear_lb Or load_tb Then Exit Sub
@ -249,6 +257,15 @@ Private Sub opPlugVol_Click()
calc_val calc_val
End Sub End Sub
Private Sub tbCOM_Change()
If tbAPI.text = "" Then tbAPI.text = "{}"
Set adjust = JsonConverter.ParseJson(tbAPI.text)
adjust("message") = tbCOM.text
tbAPI.text = JsonConverter.ConvertToJson(adjust)
End Sub
Private Sub tbFcPrice_Change() Private Sub tbFcPrice_Change()
If load_tb Then Exit Sub If load_tb Then Exit Sub
set_Price = True set_Price = True
@ -391,14 +408,14 @@ Private Sub UserForm_Activate()
For i = 1 To sp("package")("mpvt").Count For i = 1 To sp("package")("mpvt").Count
month(i, 0) = sp("package")("mpvt")(i)("order_month") month(i, 0) = sp("package")("mpvt")(i)("order_month")
month(i, 1) = sp("package")("mpvt")(i)("2019 qty") month(i, 1) = sp("package")("mpvt")(i)("2020 qty")
month(i, 2) = sp("package")("mpvt")(i)("2020 base qty") month(i, 2) = sp("package")("mpvt")(i)("2021 base qty")
month(i, 3) = sp("package")("mpvt")(i)("2020 adj qty") month(i, 3) = sp("package")("mpvt")(i)("2021 adj qty")
month(i, 4) = sp("package")("mpvt")(i)("2020 tot qty") month(i, 4) = sp("package")("mpvt")(i)("2021 tot qty")
month(i, 5) = sp("package")("mpvt")(i)("2019 value_usd") month(i, 5) = sp("package")("mpvt")(i)("2020 value_usd")
month(i, 6) = sp("package")("mpvt")(i)("2020 base value_usd") month(i, 6) = sp("package")("mpvt")(i)("2021 base value_usd")
month(i, 7) = sp("package")("mpvt")(i)("2020 adj value_usd") month(i, 7) = sp("package")("mpvt")(i)("2021 adj value_usd")
month(i, 8) = sp("package")("mpvt")(i)("2020 tot value_usd") month(i, 8) = sp("package")("mpvt")(i)("2021 tot value_usd")
If co_num(month(i, 2), 0) = 0 Then If co_num(month(i, 2), 0) = 0 Then
month(i, 9) = "addmonth" month(i, 9) = "addmonth"
Else Else
@ -408,14 +425,14 @@ Private Sub UserForm_Activate()
month(0, 0) = "month" month(0, 0) = "month"
month(13, 0) = "total" month(13, 0) = "total"
month(0, 1) = "2019 qty" month(0, 1) = "2020 qty"
month(0, 2) = "2020 base qty" month(0, 2) = "2021 base qty"
month(0, 3) = "2020 adj qty" month(0, 3) = "2021 adj qty"
month(0, 4) = "2020 qty" month(0, 4) = "2021 qty"
month(0, 5) = "2019 val" month(0, 5) = "2020 val"
month(0, 6) = "2020 base val" month(0, 6) = "2021 base val"
month(0, 7) = "2020 adj val" month(0, 7) = "2021 adj val"
month(0, 8) = "2020 val" month(0, 8) = "2021 val"
Me.crunch_array Me.crunch_array
@ -662,6 +679,7 @@ Sub calc_val()
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName adjust("user") = Application.UserName
adjust("source") = "adj" adjust("source") = "adj"
adjust("message") = tbCOM.text
If opEditSales Then If opEditSales Then
If opPlugVol Then If opPlugVol Then
adjust("type") = "scale_v" adjust("type") = "scale_v"
@ -714,6 +732,7 @@ Sub calc_price()
adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss") adjust("stamp") = Format(Date + time, "yyyy-mm-dd hh:mm:ss")
adjust("user") = Application.UserName adjust("user") = Application.UserName
adjust("source") = "adj" adjust("source") = "adj"
adjust("message") = tbCOM.text
adjust("version") = handler.plan adjust("version") = handler.plan
If opEditSales Then If opEditSales Then

BIN
fpvt.frx

Binary file not shown.

View File

@ -501,14 +501,16 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
Exit Function Exit Function
End If End If
ReDim res(json("x").Count - 1, 5) ReDim res(json("x").Count - 1, 6)
For i = 0 To UBound(res, 1) For i = 0 To UBound(res, 1)
res(i, 0) = json("x")(i + 1)("user") res(i, 0) = json("x")(i + 1)("user")
res(i, 1) = json("x")(i + 1)("stamp") res(i, 1) = json("x")(i + 1)("quota_rep_descr")
res(i, 2) = json("x")(i + 1)("comment") res(i, 2) = json("x")(i + 1)("stamp")
res(i, 3) = json("x")(i + 1)("sales") res(i, 3) = json("x")(i + 1)("comment")
res(i, 4) = json("x")(i + 1)("def") res(i, 4) = json("x")(i + 1)("sales")
res(i, 5) = json("x")(i + 1)("id")
res(i, 6) = json("x")(i + 1)("def")
Next i Next i
list_changes = res list_changes = res

View File

@ -97,9 +97,9 @@ Public Function rev_cust(cust As String) As String
End If End If
If InStr(1, cust, " - ") <= 9 Then If InStr(1, cust, " - ") <= 9 Then
rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(left(cust, 8)) rev_cust = trim(Mid(cust, 11, 100)) & " - " & trim(Left(cust, 8))
Else Else
rev_cust = trim(right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - ")) rev_cust = trim(Right(cust, 8)) & " - " & Mid(cust, 1, InStr(1, cust, " - "))
End If End If
End Function End Function
@ -486,7 +486,7 @@ Sub build_json()
Set np = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson)) Set np = JsonConverter.ParseJson(JsonConverter.ConvertToJson(basejson))
np("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") np("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
np("user") = Application.UserName np("user") = Application.UserName
np("scenario")("version") = "b20" np("scenario")("version") = handler.plan
Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]") Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
np("source") = "adj" np("source") = "adj"
np("type") = "new_basket" np("type") = "new_basket"
@ -537,7 +537,7 @@ Sub build_json()
End If End If
adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") adjust(pos)("stamp") = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
adjust(pos)("user") = Application.UserName adjust(pos)("user") = Application.UserName
adjust(pos)("scenario")("version") = "b20" adjust(pos)("scenario")("version") = handler.plan
adjust(pos)("scenario")("iter") = handler.basis adjust(pos)("scenario")("iter") = handler.basis
adjust(pos)("source") = "adj" adjust(pos)("source") = "adj"
End If End If

BIN
openf.frx

Binary file not shown.

BIN
part.frx

Binary file not shown.

View File

@ -55,8 +55,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean
For i = 1 To ri.Count For i = 1 To ri.Count
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND " If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & "," If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape(ri(i).Name) & "'" handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'"
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape(ri(i).Name) & """" jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """"
handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name
handler.sc(i - 1, 1) = ri(i).Name handler.sc(i - 1, 1) = ri(i).Name
Next i Next i
@ -97,12 +97,21 @@ Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
End Function End Function
Function escape(ByVal text As String) As String Function escape_json(ByVal text As String) As String
text = Replace(text, "'", "''")
text = Replace(text, """", "\""")
If text = "(blank)" Then text = ""
escape_json = text
End Function
Function escape_sql(ByVal text As String) As String
text = Replace(text, "'", "''") text = Replace(text, "'", "''")
text = Replace(text, """", """""") text = Replace(text, """", """""")
If text = "(blank)" Then text = "" If text = "(blank)" Then text = ""
escape = text escape_sql = text
End Function End Function