diff --git a/TheBigOne.cls b/TheBigOne.cls index eb2f194..3b8b86e 100644 --- a/TheBigOne.cls +++ b/TheBigOne.cls @@ -1,3 +1,12 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "TheBigOne" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False Option Explicit Private ADOo_con() As ADODB.Connection @@ -2364,3 +2373,4 @@ Public Function ARRAYp_get_range_string(ByRef r As range) As String() End Function + diff --git a/fpvt.frx b/fpvt.frx index 7b4c7f5..222c151 100644 Binary files a/fpvt.frx and b/fpvt.frx differ diff --git a/openf.frx b/openf.frx index 09df77e..740c9ff 100644 Binary files a/openf.frx and b/openf.frx differ diff --git a/pivot.cls b/pivot.cls new file mode 100644 index 0000000..8fe359f --- /dev/null +++ b/pivot.cls @@ -0,0 +1,107 @@ +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 + +Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) + + 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 + + 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 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 + + + + + +