145 lines
4.1 KiB
OpenEdge ABL
145 lines
4.1 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "shShipments"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = True
|
|
Option Explicit
|
|
|
|
Dim selectedSeason As Integer
|
|
Dim selectedMonth As Integer
|
|
|
|
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
|
|
Dim pt As PivotTable
|
|
Set pt = ActiveSheet.PivotTables("ptShipments")
|
|
|
|
Dim intersec As Range
|
|
Set intersec = Intersect(Target, pt.DataBodyRange)
|
|
|
|
If intersec Is Nothing Then
|
|
Exit Sub
|
|
ElseIf intersec.address <> Target.address Then
|
|
Exit Sub
|
|
End If
|
|
|
|
Cancel = True
|
|
|
|
If Target.value = "" Then
|
|
MsgBox "You cannot shift an empty cell.", vbOKOnly + vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
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 pf As PivotField
|
|
Dim pi As PivotItem
|
|
|
|
' Serialize the report filters in SQL and JSON format.
|
|
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
|
|
pt.PivotCache.Refresh
|
|
|
|
Dim segmSql As String
|
|
Dim segmJSql As String
|
|
segmSql = "segm IN ("
|
|
segmJSql = """segm"": ["
|
|
|
|
Set pf = pt.PivotFields("Segment")
|
|
For Each pi In pf.PivotItems
|
|
If pi.Visible Then
|
|
If Right(segmSql, 1) <> "(" Then
|
|
segmSql = segmSql & ", "
|
|
segmJSql = segmJSql & ", "
|
|
End If
|
|
segmSql = segmSql & "'" & escape_sql(pi.Name) & "'"
|
|
segmJSql = segmJSql & """" & escape_json(pi.Name) & """"
|
|
End If
|
|
Next
|
|
segmSql = segmSql & ")"
|
|
segmJSql = segmJSql & "]"
|
|
|
|
' Serialize the row and column items in SQL and JSON format.
|
|
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
|
|
|
|
Dim idx As Integer
|
|
idx = IIf(Right(segmSql, 2) = "()", 0, 1)
|
|
|
|
handler.sql = IIf(idx = 0, "", segmSql)
|
|
handler.jsql = IIf(idx = 0, "", segmJSql)
|
|
ReDim handler.sc(ri.Count + ci.Count + idx, 1)
|
|
|
|
If idx = 1 Then
|
|
idx = 0
|
|
handler.sc(idx, 0) = "segm"
|
|
handler.sc(idx, 1) = Mid(segmJSql, 9)
|
|
End If
|
|
|
|
Dim key As String
|
|
Dim value As Variant
|
|
|
|
For i = 1 To ri.Count
|
|
key = ri(i).Parent.Name
|
|
value = ri(i).value
|
|
|
|
If handler.sql <> "" Then handler.sql = handler.sql & vbCrLf & "AND "
|
|
If handler.sql <> "" Then handler.jsql = handler.jsql & vbCrLf & ","
|
|
handler.sql = handler.sql & key & " = '" & escape_sql(value) & "'"
|
|
handler.jsql = handler.jsql & """" & key & """:""" & escape_json(value) & """"
|
|
idx = idx + 1
|
|
handler.sc(idx, 0) = key
|
|
handler.sc(idx, 1) = value
|
|
Next i
|
|
|
|
For i = 1 To ci.Count
|
|
key = ci(i).Parent.Name
|
|
value = ci(i).value
|
|
|
|
If handler.sql <> "" Then handler.sql = handler.sql & vbCrLf & "AND "
|
|
If handler.sql <> "" Then handler.jsql = handler.jsql & vbCrLf & ","
|
|
handler.sql = handler.sql & key & " = '" & escape_sql(value) & "'"
|
|
handler.jsql = handler.jsql & """" & key & """:""" & escape_json(value) & """"
|
|
idx = idx + 1
|
|
handler.sc(idx, 0) = key
|
|
handler.sc(idx, 1) = value
|
|
|
|
If key = "ship_season" Then selectedSeason = CInt(value)
|
|
If key = "ship_month" Then selectedMonth = CInt(Left(value, 2))
|
|
Next
|
|
|
|
scenario = "{" & handler.jsql & "}"
|
|
|
|
If selectedSeason = 0 Or selectedMonth = 0 Then
|
|
MsgBox "Invalid pivot table setup. Make sure SHIP_SEASON and SHIP_MONTH are set as pivot table columns.", vbOKOnly + vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
Call handler.load_config
|
|
With shipDateShifter
|
|
.lbSDET.list = handler.sc
|
|
.selectedSeason = selectedSeason
|
|
.selectedMonth = selectedMonth
|
|
.currentValue = Target.value
|
|
.numberFormat = IIf(df.numberFormat Like "*$*", "$#,##0", "#,##0")
|
|
.Show
|
|
End With
|
|
|
|
End Sub
|
|
|
|
|