diff --git a/build.frm b/build.frm index 681d4fa..b9a4869 100644 --- a/build.frm +++ b/build.frm @@ -28,7 +28,7 @@ Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift A useval = True Me.Hide Case 27 - canel = False + useval = False Me.Hide End Select End Sub @@ -75,3 +75,4 @@ Private Sub UserForm_Activate() End Sub + diff --git a/build.frx b/build.frx index 1d32c5a..4559166 100644 Binary files a/build.frx and b/build.frx differ diff --git a/changes.frm b/changes.frm new file mode 100644 index 0000000..dc539c9 --- /dev/null +++ b/changes.frm @@ -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 + diff --git a/changes.frx b/changes.frx new file mode 100644 index 0000000..82e49b9 Binary files /dev/null and b/changes.frx differ diff --git a/fpvt.frm b/fpvt.frm index 13c8a28..340b5a9 100644 --- a/fpvt.frm +++ b/fpvt.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} fpvt Caption = "Forecast Adjustment" - ClientHeight = 7590 + ClientHeight = 7350 ClientLeft = 120 ClientTop = 465 - ClientWidth = 7095 + ClientWidth = 7110 OleObjectBlob = "fpvt.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -147,6 +147,10 @@ Private Sub lbMonth_Change() +End Sub + +Private Sub lheader_Click() + End Sub Private Sub opEditPrice_Click() @@ -301,10 +305,15 @@ Private Sub UserForm_Activate() 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 @@ -327,6 +336,12 @@ Private Sub UserForm_Activate() fVol = 0 fPrc = 0 + 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 diff --git a/fpvt.frx b/fpvt.frx index 5184950..2d75cf9 100644 Binary files a/fpvt.frx and b/fpvt.frx differ diff --git a/handler.bas b/handler.bas index 4d3f98f..8016a2f 100644 --- a/handler.bas +++ b/handler.bas @@ -203,8 +203,8 @@ 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 Integer - Dim j As Integer + Dim i As Long + Dim j As Long Dim str() As String If doc = "" Then @@ -212,7 +212,11 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object 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 @@ -292,22 +296,25 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object 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 +' 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) + + 'Call x.SHTp_Dump(str, "data", CLng(i), 1, False, False, 28, 29, 30, 31, 32) Sheets("Orders").PivotTables("PivotTable1").PivotCache.Refresh @@ -468,3 +475,55 @@ Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant 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 diff --git a/months.cls b/months.cls index 31c249c..260ef0e 100644 --- a/months.cls +++ b/months.cls @@ -800,7 +800,7 @@ Sub post_adjust() End If Sheets("Orders").Select - Worksheets("month").Visible = xlHidden + 'Worksheets("month").Visible = xlHidden End Sub diff --git a/pivot.cls b/pivot.cls index 927e2c4..5a4589b 100644 --- a/pivot.cls +++ b/pivot.cls @@ -101,6 +101,7 @@ Function escape(ByVal text As String) As String text = Replace(text, "'", "''") text = Replace(text, """", """""") + If text = "(blank)" Then text = "" escape = text End Function