VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "shWalk" 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("ptWalk") ' 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 ' ' 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) ' ' 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 ' '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 ' '