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