pt/forecast_api
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Remove the code from the Walk sheet. Actually, just comment it out.

Browse Source
This commit is contained in:
PhilRunninger 2023-03-22 12:05:02 -04:00
parent 85829efd1d
commit bbac2ec390
1 changed files with 104 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

207
VBA/shWalk.cls
View File

@ -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
'
'