aa13911c02
Tread the PivotTable filters the same as the row headers, making them part of the WHERE clause in the SQL statement.
149 lines
3.8 KiB
OpenEdge ABL
149 lines
3.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 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
|
|
|
|
Function piv_pos(list As Object, target_pos As Long) As Long
|
|
|
|
Dim i As Long
|
|
|
|
For i = 1 To list.Count
|
|
If list(i).Position = target_pos Then
|
|
piv_pos = i
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
'should not get to this point
|
|
|
|
End Function
|
|
|
|
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
|
|
|
|
Dim i As Integer
|
|
|
|
For i = 1 To pt.PivotFields.Count
|
|
If pt.PivotFields(i).Name = field_name Then
|
|
piv_fld_index = i
|
|
Exit Function
|
|
End If
|
|
Next i
|
|
|
|
End Function
|
|
|
|
Function escape_json(ByVal text As String) As String
|
|
|
|
text = Replace(text, "'", "''")
|
|
text = Replace(text, """", "\""")
|
|
If text = "(blank)" Then text = ""
|
|
escape_json = text
|
|
|
|
End Function
|
|
|
|
Function escape_sql(ByVal text As String) As String
|
|
|
|
text = Replace(text, "'", "''")
|
|
text = Replace(text, """", """""")
|
|
If text = "(blank)" Then text = ""
|
|
escape_sql = text
|
|
|
|
End Function
|
|
|
|
|