forecast_api/Master Template.xlsm_EXPORTS/shOrders.cls

102 lines
2.9 KiB
OpenEdge ABL

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "shOrders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables("ptOrders")
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
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("segm")
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 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 segmOffset As Integer
segmOffset = IIf(Right(segmSql, 2) = "()", 0, 1)
handler.sql = ""
handler.jsql = ""
ReDim handler.sc(ri.Count + segmOffset, 1)
If segmOffset = 1 Then
handler.sql = segmSql
handler.jsql = segmJSql
handler.sc(0, 0) = "segm"
handler.sc(0, 1) = Mid(segmJSql, 9)
End If
For i = 1 To ri.Count
If handler.sql <> "" Then handler.sql = handler.sql & vbCrLf & "AND "
If handler.sql <> "" Then handler.jsql = handler.jsql & vbCrLf & ","
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'"
handler.jsql = handler.jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """"
handler.sc(i - 1 + segmOffset, 0) = rd(piv_pos(rd, i)).Name
handler.sc(i - 1 + segmOffset, 1) = ri(i).Name
Next i
scenario = "{" & handler.jsql & "}"
Call handler.load_config
Call handler.load_fpvt
End Sub