Doubleclick on form's pivot cell --> filtered datasheet view (like in excel)

Ipem

Registered User.
Local time
Today, 13:10
Joined
Aug 26, 2013
Messages
29
Hello all,
I would like to share this piece of code with you.
When copied in a form's module, it will let you go directly to filtered datasheet view when you doubleclick on a cell in pivot table view (Access 2007), by
  • creating the new filter string, which includes your current filter string, and the pivot filter according the table column and row names.
  • go to datasheet view, and apply the new filter string
I know, the code is still messy, USE ONLY AT YOUR OWN RISK!

I have copied the BuildFullName function from an MSDN article.


Code:
Private Sub Form_DblClick(Cancel As Integer)
If Not (Me.CurrentView = acCurViewPivotTable) Then Exit Sub
 Dim sel As Object
 Dim pivotagg As Variant
 Dim sColMems As String
 Dim sRowMems As String
 Dim sFilters As String
 Dim colfilters() As String
 Dim rowfilters() As String
 Dim i As Integer
 Dim a As Integer
 Dim orig_filter As String
 orig_filter = Me.Filter
 If Not orig_filter = "" Then orig_filter = orig_filter & " AND"
 Set sel = Me.PivotTable.Selection
 If TypeName(sel) = "PivotAggregates" Then
    Set pivotagg = sel.Item(0)
    sColMems = BuildFullName(pivotagg.Cell.ColumnMember)
    sRowMems = BuildFullName(pivotagg.Cell.RowMember)
 End If
 colfilters = Split(sColMems, "-")
 rowfilters = Split(sRowMems, "-")
   
 For i = 1 To UBound(colfilters)
     a = InStr(1, colfilters(i), "]")
     tmp = " And " & Mid(colfilters(i), 1, a) & " = '" & _
     Mid(colfilters(i), a + 1, Len(colfilters(i)) - a) & "'"
     If Not (InStr(1, tmp, "Total")) = 0 Then tmp = ""
     sFilters = sFilters & tmp
 Next
 For i = 1 To UBound(rowfilters)
     a = InStr(1, rowfilters(i), "]")
     tmp = " And " & Mid(rowfilters(i), 1, a) & " = '" & _
     Mid(rowfilters(i), a + 1, Len(rowfilters(i)) - a) & "'"
     If Not (InStr(1, tmp, "Total")) = 0 Then tmp = ""
     sFilters = sFilters & tmp
 Next
 
 If Not sFilters = "" Then sFilters = Right(sFilters, Len(sFilters) - 4)
 sFilters = Replace(sFilters, "= '(Blank)'", "Is Null")
 sel.Item(0).Cell.Expanded = False
 
 
 If sFilters = "" Then orig_filter = Left(orig_filter, Len(orig_filter) - 4)
 Me.Filter = orig_filter & sFilters
 Me.FilterOn = True
 DoCmd.RunCommand acCmdFormView
 
 
End Sub
Function BuildFullName(PivotMem)
 Dim pmTemp As Variant
 Dim sFullName As String
 sFullName = Split(PivotMem.UniqueName, ".")(0) & PivotMem.Caption
 Set pmTemp = PivotMem
 While Not (pmTemp.ParentMember Is Nothing)
    Set pmTemp = pmTemp.ParentMember
    sFullName = Split(pmTemp.UniqueName, ".")(0) & pmTemp.Caption & "-" & sFullName
 Wend
  BuildFullName = sFullName
End Function
 

Users who are viewing this thread

Back
Top Bottom