Excel VBA - 檢查報告切片器選擇（如果全部選中，跳過）

Question

我需要某些VBA代碼的幫助。我有一個AgeRange切片器，我有一個工作腳本插入一行，添加時間戳，然後報告切片器選擇。

我想添加一些東西，這將跳過如果在切片器中的所有項目被選中（真）的過程。

有什麼我可以插入說「如果切片機沒有被觸摸（所有項目都是真的），然後結束小組」。

下面是我對到目前爲止的代碼：

Dim cache As Excel.SlicerCache 
Set cache = ActiveWorkbook.SlicerCaches("Slicer_AgeRange") 
Dim sItem As Excel.SlicerItem 
For Each sItem In cache.SlicerItems 
If sItem.Selected = True Then xAge = xAge & sItem.Name & ", " 
Next sItem 
Rows("1:1").Select 
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
Range("A1").Select 
ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM") 
Range("B1").Select 
ActiveCell.FormulaR1C1 = xAge 
Range("C1").Select 
End Sub 

任何幫助，不勝感激！

Answer 1

Nvm。我自己做到了。 :)

Dim cache As Excel.SlicerCache 
Dim sName As Slicers 
Dim sItem As Excel.SlicerItem 
Dim xSlice As String 
Dim xName As String 

For Each cache In ActiveWorkbook.SlicerCaches 

    xName = StrConv(Replace(cache.Name,  "AgeRange", "Ages") 
    xCheck = 0 
    For Each sItem In cache.SlicerItems 
     If sItem.Selected = False Then 
      xCheck = xCheck + 1 
     Else 
      xCheck = xCheck 
     End If 
    Next sItem 

    If xCheck > 0 Then 
    For Each sItem In cache.SlicerItems 
     If sItem.Selected = True Then 
      xSlice = xSlice & sItem.Caption & ", " 
     End If 
    Next sItem 

     Rows("1:1").Select 
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
     Range("B1").Select 
     ActiveCell.FormulaR1C1 = xName & ": " & xSlice 
     xSlice = "" 
    End If 

Next cache 

    Range("A1").Select 
    ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM") 


End Sub 

Answer 2

這是比你要求的多一點，但我想我會分享，因爲我只是寫這個供我自己使用。只有當它們被過濾（並非全部選中）時，它纔會清除物理上位於工作表上的所有切片。對於你的問題，好處是每個項目循環。和緊隨其後的線路。

Sub clearWorksheetSlicers(ws As Worksheet) 
'clears all slicers that have their shape on a specific worksheet 

Dim slSlicer As Slicer 
Dim slCache As SlicerCache 
Dim item As SlicerItem 
Dim hasUnSel As Boolean 

For Each slCache In ThisWorkbook.SlicerCaches 
    For Each slSlicer In slCache.Slicers 
     If slSlicer.Shape.Parent Is ws Then 
      For Each item In slCache.SlicerItems 
       If item.Selected = False Then 
        hasUnSel = True 
        Exit For 
       End If 
      Next item 
      If hasUnSel = True Then slCache.ClearManualFilter 
      hasUnSel = False 
     End If 
    Next slSlicer 
Next slCache 

End Sub