This commit is contained in:
Paul Trowbridge 2019-03-15 16:42:58 -04:00
parent 64cb03a975
commit d2a9549e77
3 changed files with 112 additions and 3 deletions

BIN
fpvt.frx

Binary file not shown.

View File

@ -342,7 +342,7 @@ Sub month_tosheet(ByRef pkg() As Variant)
Set sh = Sheets("_month") Set sh = Sheets("_month")
Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}") Set j = JsonConverter.ParseJson("{""scenario"":" & scenario & "}")
sh.Cells(1, 16) = JsonConverter.ConvertToJson(j)
For i = 0 To 12 For i = 0 To 12
'------------volume------------------- '------------volume-------------------
@ -407,11 +407,13 @@ Sub month_tosheet(ByRef pkg() As Variant)
End If End If
'--json-- '--json--
sh.Cells(i + 1, 16) = JsonConverter.ConvertToJson(j)
End If End If
Next i Next i
months.load_sheet
End Sub End Sub
Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant Function co_num(ByRef one As Variant, ByRef two As Variant) As Variant

107
pivot.cls Normal file
View File

@ -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