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_Creatable = False
Attribute VB_PredeclaredId = True Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True Attribute VB_Exposed = True
Option Explicit ' Option Explicit
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pt As PivotTable ' Dim pt As PivotTable
Set pt = ActiveSheet.PivotTables("ptWalk") ' Set pt = ActiveSheet.PivotTables("ptWalk")
Dim intersec As Range ' Dim intersec As Range
Set intersec = Intersect(Target, pt.DataBodyRange) ' Set intersec = Intersect(Target, pt.DataBodyRange)
'
If intersec Is Nothing Then ' If intersec Is Nothing Then
Exit Sub ' Exit Sub
ElseIf intersec.address <> Target.address Then ' ElseIf intersec.address <> Target.address Then
Exit Sub ' Exit Sub
End If ' End If
'
Cancel = True ' Cancel = True
'
Dim i As Long ' Dim i As Long
Dim j As Long ' Dim j As Long
Dim k As Long ' Dim k As Long
'
Dim ri As PivotItemList ' Dim ri As PivotItemList
Dim ci As PivotItemList ' Dim ci As PivotItemList
Dim df As Object ' Dim df As Object
Dim rd As Object ' Dim rd As Object
Dim cd As Object ' Dim cd As Object
Dim dd As Object ' Dim dd As Object
'
Dim pf As PivotField ' Dim pf As PivotField
Dim pi As PivotItem ' Dim pi As PivotItem
'
Set ri = Target.Cells.PivotCell.RowItems ' Set ri = Target.Cells.PivotCell.RowItems
Set ci = Target.Cells.PivotCell.ColumnItems ' Set ci = Target.Cells.PivotCell.ColumnItems
Set df = Target.Cells.PivotCell.DataField ' Set df = Target.Cells.PivotCell.DataField
'
Set rd = Target.Cells.PivotTable.RowFields ' Set rd = Target.Cells.PivotTable.RowFields
Set cd = Target.Cells.PivotTable.ColumnFields ' Set cd = Target.Cells.PivotTable.ColumnFields
'
ReDim handler.sc(ri.Count, 1) ' ReDim handler.sc(ri.Count, 1)
'
handler.sql = "" ' handler.sql = ""
handler.jsql = "" ' handler.jsql = ""
'
For i = 1 To ri.Count ' For i = 1 To ri.Count
If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND " ' If i <> 1 Then handler.sql = handler.sql & vbCrLf & "AND "
If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & "," ' If i <> 1 Then handler.jsql = handler.jsql & vbCrLf & ","
handler.sql = handler.sql & rd(piv_pos(rd, i)).Name & " = '" & escape_sql(ri(i).Name) & "'" ' 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) & """" ' 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, 0) = rd(piv_pos(rd, i)).Name
handler.sc(i - 1, 1) = ri(i).Name ' handler.sc(i - 1, 1) = ri(i).Name
Next i ' Next i
'
scenario = "{" & handler.jsql & "}" ' scenario = "{" & handler.jsql & "}"
'
Call handler.load_config ' Call handler.load_config
Call handler.load_fpvt ' Call handler.load_fpvt
'
End Sub ' End Sub
'
Function piv_pos(list As Object, target_pos As Long) As Long ' Function piv_pos(list As Object, target_pos As Long) As Long
'
Dim i As Long ' Dim i As Long
'
For i = 1 To list.Count ' For i = 1 To list.Count
If list(i).Position = target_pos Then ' If list(i).Position = target_pos Then
piv_pos = i ' piv_pos = i
Exit Function ' Exit Function
End If ' End If
Next i ' Next i
'should not get to this point ' 'should not get to this point
'
End Function ' End Function
'
Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer ' Function piv_fld_index(field_name As String, ByRef pt As PivotTable) As Integer
'
Dim i As Integer ' Dim i As Integer
'
For i = 1 To pt.PivotFields.Count ' For i = 1 To pt.PivotFields.Count
If pt.PivotFields(i).Name = field_name Then ' If pt.PivotFields(i).Name = field_name Then
piv_fld_index = i ' piv_fld_index = i
Exit Function ' Exit Function
End If ' End If
Next i ' Next i
'
End Function ' End Function
'
Function escape_json(ByVal text As String) As String ' Function escape_json(ByVal text As String) As String
'
text = Replace(text, "'", "''") ' text = Replace(text, "'", "''")
text = Replace(text, """", "\""") ' text = Replace(text, """", "\""")
If text = "(blank)" Then text = "" ' If text = "(blank)" Then text = ""
escape_json = text ' escape_json = text
'
End Function ' End Function
'
Function escape_sql(ByVal text As String) As String ' Function escape_sql(ByVal text As String) As String
'
text = Replace(text, "'", "''") ' text = Replace(text, "'", "''")
text = Replace(text, """", """""") ' text = Replace(text, """", """""")
If text = "(blank)" Then text = "" ' If text = "(blank)" Then text = ""
escape_sql = text ' escape_sql = text
'
End Function ' End Function
'
'