list history of changes

This commit is contained in:
Trowbridge 2019-03-22 18:18:23 -04:00
parent 1a09f55fb9
commit 830894ed5d
9 changed files with 145 additions and 16 deletions

View File

@ -28,7 +28,7 @@ Private Sub cbBill_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift A
useval = True useval = True
Me.Hide Me.Hide
Case 27 Case 27
canel = False useval = False
Me.Hide Me.Hide
End Select End Select
End Sub End Sub
@ -75,3 +75,4 @@ Private Sub UserForm_Activate()
End Sub End Sub

BIN
build.frx

Binary file not shown.

53
changes.frm Normal file
View 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

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 = 7590 ClientHeight = 7350
ClientLeft = 120 ClientLeft = 120
ClientTop = 465 ClientTop = 465
ClientWidth = 7095 ClientWidth = 7110
OleObjectBlob = "fpvt.frx":0000 OleObjectBlob = "fpvt.frx":0000
StartUpPosition = 1 'CenterOwner StartUpPosition = 1 'CenterOwner
End End
@ -147,6 +147,10 @@ Private Sub lbMonth_Change()
End Sub
Private Sub lheader_Click()
End Sub End Sub
Private Sub opEditPrice_Click() Private Sub opEditPrice_Click()
@ -301,10 +305,15 @@ Private Sub UserForm_Activate()
Dim k As Long Dim k As Long
Dim ok As Boolean Dim ok As Boolean
Me.Caption = "Forecast Adjust " & Worksheets("config").Cells(8, 2)
Me.mp.Visible = False Me.mp.Visible = False
Me.lheader = "Loading..."
Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok) Set sp = handler.scenario_package("{""scenario"":" & scenario & "}", ok)
Me.lheader = "Ready"
If Not ok Then If Not ok Then
fpvt.Hide fpvt.Hide
Application.StatusBar = False Application.StatusBar = False
@ -327,6 +336,12 @@ Private Sub UserForm_Activate()
fVol = 0 fVol = 0
fPrc = 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 For i = 1 To sp("package")("totals").Count
Select Case sp("package")("totals")(i)("order_season") Select Case sp("package")("totals")(i)("order_season")
Case 2020 Case 2020

BIN
fpvt.frx

Binary file not shown.

View File

@ -203,8 +203,8 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Dim req As New WinHttp.WinHttpRequest Dim req As New WinHttp.WinHttpRequest
Dim json As Object Dim json As Object
Dim wr As String Dim wr As String
Dim i As Integer Dim i As Long
Dim j As Integer Dim j As Long
Dim str() As String Dim str() As String
If doc = "" Then If doc = "" Then
@ -212,7 +212,11 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
Exit Function Exit Function
End If End If
'update timestamp
Set json = JsonConverter.ParseJson(doc) 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) server = Sheets("config").Cells(1, 2)
With req 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)) ReDim str(UBound(res, 1), UBound(res, 2))
For i = 0 To UBound(res, 1) ' For i = 0 To UBound(res, 1)
For j = 0 To UBound(res, 2) ' For j = 0 To UBound(res, 2)
If IsNull(res(i, j)) Then ' If IsNull(res(i, j)) Then
str(i, j) = "" ' str(i, j) = ""
Else ' Else
str(i, j) = res(i, j) ' str(i, j) = res(i, j)
End If ' End If
Next j ' Next j
Next i ' Next i
i = 1
Do Until Sheets("data").Cells(i, 1) = "" Do Until Sheets("data").Cells(i, 1) = ""
i = i + 1 i = i + 1
Loop 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 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 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

View File

@ -800,7 +800,7 @@ Sub post_adjust()
End If End If
Sheets("Orders").Select Sheets("Orders").Select
Worksheets("month").Visible = xlHidden 'Worksheets("month").Visible = xlHidden
End Sub End Sub

View File

@ -101,6 +101,7 @@ Function escape(ByVal text As String) As String
text = Replace(text, "'", "''") text = Replace(text, "'", "''")
text = Replace(text, """", """""") text = Replace(text, """", """""")
If text = "(blank)" Then text = ""
escape = text escape = text
End Function End Function