VBA/pivot.bas

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_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, ActiveSheet.Range("b7: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 & " = '" & ri(i).Name & "'"
        jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & 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