Remove the code from the Walk sheet. Actually, just comment it out.
This commit is contained in:
PhilRunninger
parent
85829efd1d
commit
bbac2ec390
207
VBA/shWalk.cls
207
VBA/shWalk.cls
|
|
@ -7,107 +7,108 @@ 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
|
||||
|
||||
' 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
|
||||
'
|
||||
'
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue