pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lot of changes

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
build.frx
View File

Binary file not shown.

5
changes.frm
View File

@ -27,7 +27,7 @@ Private Sub lbHist_Change()
For i = 0 To Me.lbHist.ListCount - 1
If Me.lbHist.Selected(i) Then
Me.tbPrint.value = x(i, 4)
Me.tbPrint.value = x(i, 6)
Exit Sub
End If
Next i
@ -42,7 +42,8 @@ Private Sub UserForm_Activate()
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
Me.Hide
Exit Sub

BIN
changes.frx
View File

Binary file not shown.

55
fpvt.frm
View File

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

BIN
fpvt.frx
View File

Binary file not shown.

12
handler.bas
View File

@ -501,14 +501,16 @@ Function list_changes(doc As String, ByRef fail As Boolean) As Variant()
Exit Function
End If
ReDim res(json("x").Count - 1, 5)
ReDim res(json("x").Count - 1, 6)
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")
res(i, 1) = json("x")(i + 1)("quota_rep_descr")
res(i, 2) = json("x")(i + 1)("stamp")
res(i, 3) = json("x")(i + 1)("comment")
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
list_changes = res

8
months.cls
View File

@ -97,9 +97,9 @@ Public Function rev_cust(cust As String) As String
End If
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
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 Function
@ -486,7 +486,7 @@ Sub build_json()
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"
np("scenario")("version") = handler.plan
Set np("scenario")("iter") = JsonConverter.ParseJson("[""copy""]")
np("source") = "adj"
np("type") = "new_basket"
@ -537,7 +537,7 @@ Sub build_json()
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")("version") = handler.plan
adjust(pos)("scenario")("iter") = handler.basis
adjust(pos)("source") = "adj"
End If

BIN
openf.frx
View File

Binary file not shown.

BIN
part.frx
View File

Binary file not shown.

17
pivot.cls
View File

@ -55,8 +55,8 @@ Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean
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.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(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, 1) = ri(i).Name
Next i
@ -97,12 +97,21 @@ Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
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, """", """""")
If text = "(blank)" Then text = ""
escape = text
escape_sql = text
End Function