forecast_api/Master Template.xlsm_EXPORTS/shOrders.cls
PhilRunninger 44dd489377 Use streamlined code to get pivot table key fields.
This allows me to get rid of unnecessary (and duplicated) code.
2024-04-01 17:54:09 -04:00

106 lines
2.8 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 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 + idx - 1, 1)
If idx = 1 Then
handler.sc(0, 0) = "segm"
handler.sc(0, 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) & """"
handler.sc(idx, 0) = key
handler.sc(idx, 1) = value
idx = idx + 1
Next i
scenario = "{" & handler.jsql & "}"
Call handler.load_config
Call handler.load_fpvt
End Sub