VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "pivot" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Option Explicit Private Sub Worksheet_Activate() End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then Exit Sub End If On Error GoTo nopiv If Target.Cells.PivotTable Is Nothing 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 pt As PivotTable Dim pf As PivotField Dim pi As PivotItem Dim wapi As New Windows_API 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 ReDim handler.sc(ri.Count, 1) Set pt = Target.Cells.PivotCell.PivotTable handler.sql = "" handler.jsql = "" For i = 1 To ri.Count If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND " If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & "," handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'" jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & escape_json(ri(i).Name) & """" handler.sc(i - 1, 0) = rd(piv_pos(rd, i)).Name handler.sc(i - 1, 1) = ri(i).Name Next i scenario = "{" & handler.jsql & "}" Call handler.load_config Call handler.load_fpvt nopiv: 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