PowerPivot PivotTable-Slicer-Auswahl

Question

Ich habe online einige UDFs gefunden, die die Auswahl eines Slicers einer PivotTable erfassen können. Sie funktionieren jedoch nur, wenn die PivotTable auf einer Excel-Tabelle basiert. Wenn es eine PowerPivot PivotTable ist (wie in meinem Fall), funktionieren sie nicht.

In diesem Beitrag PowerPivot Slicer selection based on cell value using VBA wird erläutert, dass Sie bei Verwendung einer PowerPivot-PivotTable auf das SlicerCacheLevel-Objekt und nicht auf den SlicerCache zugreifen müssen.

Wenn jemand helfen kann, die folgenden UDFs so zu modifizieren, dass sie für PowerPivot PivotTables-Slicer funktionieren, wäre das fantastisch und ich denke, viele andere Excel-Benutzer werden ein Gebet für Ihre Hilfe sprechen.

Ich werde hier posten die beiden UDF und ihre Quellen: Die erste: 'http://www.jkp-ads.com/Articles/slicers05.asp

Public Function GetSelectedSlicerItems(SlicerName As String) As String 
    Dim oSc As SlicerCache 
    Dim oSi As SlicerItem 
    Dim lCt As Long 
    On Error Resume Next 
    Application.Volatile 
    Set oSc = ThisWorkbook.SlicerCaches(SlicerName) 
    If Not oSc Is Nothing Then 
     For Each oSi In oSc.SlicerItems 
      If oSi.Selected Then 
       GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Name & ", " 
       lCt = lCt + 1 
      ElseIf oSi.HasData = False Then 
       lCt = lCt + 1 
      End If 
     Next 
     If Len(GetSelectedSlicerItems) > 0 Then 
      If lCt = oSc.SlicerItems.Count Then 
       GetSelectedSlicerItems = "All" 
      Else 
       GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2) 
      End If 
     Else 
      GetSelectedSlicerItems = "No items selected" 
     End If 
    Else 
     GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found" 
    End If 
End Function 

Die zweite: https://social.msdn.microsoft.com/Forums/office/en-US/d7893d81-938c-46d6-9b4c-7cd1b0b4fbf4/retrieve-the-value-selected-in-a-slicer?forum=exceldev

Public Function FblSlicerSelections(Slicer_Name As String, Optional Delimiter As Variant, Optional Wrap_Length As Variant) 
' Type Variant must be used for Optional Parameters for the IsMissing function to work below. 
Dim i, r, s As Integer: r = 1: s = 0 ' i = slicer Item, r = Rows in output, s = count of Selected items 
FblSlicerSelections = "" 
If IsMissing(Delimiter) Then Delimiter = " " 
If IsMissing(Wrap_Length) Then Wrap_Length = 40 
With ActiveWorkbook.SlicerCaches(Slicer_Name) 
    For i = 1 To .SlicerItems.Count 
     If .SlicerItems(i).Selected Then 
      s = s + 1 ' Selected count increment 
      If .SlicerItems(i).HasData Then 
       If Len(FblSlicerSelections) > r * Wrap_Length Then 
        FblSlicerSelections = FblSlicerSelections & vbCr & " " 
        r = r + 1.2 ' Modify multiplier used to determine when to wrap output (via carriage return) 
       End If 
       FblSlicerSelections = FblSlicerSelections & .SlicerItems(i).Value & Delimiter 
      End If 
     End If 
    Next i 
    If s = .SlicerItems.Count Then FblSlicerSelections = "All" & Delimiter ' Selected count = SlicersItems.Count 
End With 
FblSlicerSelections = Left(FblSlicerSelections, Len(FblSlicerSelections) - Len(Delimiter)) ' remove extra delimiter 
End Function 

Answer 1

Okay, Panik über. Ich habe es geschafft, beide Funktionen zu ändern, um jetzt mit Slicer von externen Quellen (zB PowerPivot) zu arbeiten. Ich hoffe, dass jemand von diesen UDFs profitieren wird.

Public Function GetSelectedSlicerItems (SlicerName As String) As String 'http://www.jkp-ads.com/Articles/slicers05.asp Dim osc Als SlicerCacheLevel' SlicerCache Dim oSi Wie SlicerItem Dim LCT As Long On Error Resume Next Application.Volatile

Set oSc = ThisWorkbook.SlicerCaches(SlicerName).SlicerCacheLevels(1) 

If Not oSc Is Nothing Then 
    For Each oSi In oSc.SlicerItems 
     If oSi.Selected Then 
      GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Caption & ", " 'Initial code: oSi.Caption // There are 3 "choices": .Caption .Name .Value 
      lCt = lCt + 1 
     ElseIf oSi.HasData = False Then 
      lCt = lCt + 1 
     End If 
    Next 
    If Len(GetSelectedSlicerItems) > 0 Then 
     If lCt = oSc.SlicerItems.Count Then 
      GetSelectedSlicerItems = "All" 
     Else 
      GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2) 
     End If 
    Else 
     GetSelectedSlicerItems = "No items selected" 
    End If 
Else 
    GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found" 
End If 
End Function 

Und die zweite UDF:

Public Function FblSlicerSelections(Slicer_Name As String, Optional Delimiter As Variant, Optional Wrap_Length As Variant) 
Application.Volatile 
'https://social.msdn.microsoft.com/Forums/office/en-US/d7893d81-938c-46d6-9b4c-7cd1b0b4fbf4/retrieve-the-value-selected-in-a-slicer?forum=exceldev 
' Type Variant must be used for Optional Parameters for the IsMissing function to work below. 
Dim i, r, s As Integer: r = 1: s = 0 ' i = slicer Item, r = Rows in output, s = count of Selected items 
FblSlicerSelections = "" 
If IsMissing(Delimiter) Then Delimiter = " " 
If IsMissing(Wrap_Length) Then Wrap_Length = 40 

With ActiveWorkbook.SlicerCaches(Slicer_Name).SlicerCacheLevels(1) 

    For i = 1 To .SlicerItems.Count 

     If .SlicerItems(i).Selected Then 
      s = s + 1 ' Selected count increment 
      If .SlicerItems(i).HasData Then 
       If Len(FblSlicerSelections) > r * Wrap_Length Then 
        FblSlicerSelections = FblSlicerSelections & vbCr & " " 
        r = r + 1.2 ' Modify multiplier used to determine when to wrap output (via carriage return) 
       End If 
       FblSlicerSelections = FblSlicerSelections & .SlicerItems(i).Value & Delimiter 
      End If 
     End If 
    Next i 

    If s = .SlicerItems.Count Then FblSlicerSelections = "All" & Delimiter ' Selected count = SlicersItems.Count 
End With 

FblSlicerSelections = Left(FblSlicerSelections, Len(FblSlicerSelections) - Len(Delimiter)) ' remove extra delimiter 
End Function