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
|
|
|
|
|
2019-03-19 10:57:56 -04:00
|
|
|
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, cancel As Boolean)
|
2019-03-15 16:42:58 -04:00
|
|
|
|
|
|
|
If Intersect(target, ActiveSheet.Range("b7:v100000")) Is Nothing Then
|
|
|
|
Exit Sub
|
|
|
|
End If
|
|
|
|
|
|
|
|
On Error GoTo nopiv
|
|
|
|
|
|
|
|
If target.Cells.PivotTable Is Nothing Then
|
|
|
|
Exit Sub
|
|
|
|
End If
|
|
|
|
|
2019-03-19 10:57:56 -04: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
|
|
|
|
|
|
|
|
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)
|
|
|
|
Set pt = target.Cells.PivotCell.PivotTable
|
|
|
|
|
|
|
|
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 & " = '" & ri(i).Name & "'"
|
|
|
|
jsql = jsql & """" & rd(piv_pos(rd, i)).Name & """:""" & 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
|
|
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|