VBA/pivot.cls

123 lines
2.8 KiB
OpenEdge ABL
Raw Permalink Normal View History

2019-03-15 16:42:58 -04:00
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
2020-02-19 23:03:48 -05:00
Private Sub Worksheet_Activate()
2019-03-15 16:42:58 -04:00
2020-02-19 23:03:48 -05:00
End Sub
2020-03-05 01:08:10 -05:00
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
2020-02-19 23:03:48 -05:00
2020-03-03 23:22:13 -05:00
If Intersect(Target, ActiveSheet.Range("b8:v100000")) Is Nothing Then
2019-03-15 16:42:58 -04:00
Exit Sub
End If
2019-03-15 16:42:58 -04:00
On Error GoTo nopiv
2020-02-19 23:03:48 -05:00
If Target.Cells.PivotTable Is Nothing Then
2019-03-15 16:42:58 -04:00
Exit Sub
End If
2020-03-05 01:08:10 -05:00
Cancel = True
2019-03-15 16:42:58 -04:00
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
2020-02-19 23:03:48 -05:00
Set ri = Target.Cells.PivotCell.RowItems
Set ci = Target.Cells.PivotCell.ColumnItems
Set df = Target.Cells.PivotCell.DataField
2019-03-15 16:42:58 -04:00
2020-02-19 23:03:48 -05:00
Set rd = Target.Cells.PivotTable.RowFields
Set cd = Target.Cells.PivotTable.ColumnFields
2019-03-15 16:42:58 -04:00
ReDim handler.sc(ri.Count, 1)
2020-02-19 23:03:48 -05:00
Set pt = Target.Cells.PivotCell.PivotTable
2019-03-15 16:42:58 -04:00
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 & ","
2020-02-14 02:27:01 -05:00
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) & """"
2019-03-15 16:42:58 -04:00
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
2020-02-14 02:27:01 -05:00
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, """", """""")
2019-03-22 18:18:23 -04:00
If text = "(blank)" Then text = ""
2020-02-14 02:27:01 -05:00
escape_sql = text
End Function
2019-03-15 16:42:58 -04:00