diff --git a/fpvt.frx b/fpvt.frx index 0d88ecb..089b632 100644 Binary files a/fpvt.frx and b/fpvt.frx differ diff --git a/handler.bas b/handler.bas index 3971e9b..7bfdef9 100644 --- a/handler.bas +++ b/handler.bas @@ -342,7 +342,7 @@ Sub month_tosheet(ByRef pkg() As Variant) Set sh = Sheets("_month") Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") - + sh.Cells(1, 16) = JsonConverter.ConvertToJson(j) For i = 0 To 12 '------------volume------------------- @@ -407,11 +407,13 @@ Sub month_tosheet(ByRef pkg() As Variant) End If '--json-- - sh.Cells(i + 1, 16) = JsonConverter.ConvertToJson(j) + End If - Next i + + months.load_sheet + End Sub Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant diff --git a/pivot.cls b/pivot.cls new file mode 100644 index 0000000..6bf2fa3 --- /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 + + + + + +