VBA лучший способ кодировать повторяющиеся условия

Question

У меня есть шесть местоположений a, b, c, d, e, f в моем поворотном слайсере, а у меня пять имеют формы на основе, которые имеют серый цвет. На основе выбора в слайсере цвет коробки изменится на зеленый. Когда все местоположения выбраны, все поля станут зелеными. Я достиг этого через условие в VBA. Но я смущен тем, как удовлетворять условию, когда пользователь выбирает только три или два местоположения. Каков наилучший способ кодирования, чтобы удовлетворить это условие

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) 
    If Target.Name = "PivotTable4" Then 
     If ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("a").Selected = True Then 
      With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor 
       .RGB = vbGreen 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
     ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("b").Selected = True Then 
      With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor 
       .RGB = vbGreen 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
     ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("c").Selected = True Then 
      With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor 
       .RGB = vbGreen 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
     ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("d").Selected = True Then 
      With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor 
       .RGB = vbGreen 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
     ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("e").Selected = True Then 
      With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor 
       .RGB = vbGreen 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
     ElseIf ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems("f").Selected = True Then 
      With ActiveSheet.Shapes("Freeform: Shape 9").Fill.ForeColor 
       .RGB = vbGreen 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 7").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 12").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 11").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 15").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
      With ActiveSheet.Shapes("Freeform: Shape 6").Fill.ForeColor 
       .RGB = RGB(205, 192, 176) 
      End With 
     End If 
    End If 
End Sub 

Answer 1

Вы можете использовать словарь, чтобы хранить имена формы и соответствующие имена Slicer, и установить формы цвета в зависимости от ломтерезки выбранного состояния:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) 
    Dim sShape 
    If Target.Name = "PivotTable4" Then 
     ' instantiate dictionary 
     With CreateObject("Scripting.Dictionary") 
      ' fill the dict with shape names as keys and corresponding slicer names as values 
      .Item("Freeform: Shape 6") = "a" 
      .Item("Freeform: Shape 15") = "b" 
      .Item("Freeform: Shape 11") = "c" 
      .Item("Freeform: Shape 12") = "d" 
      .Item("Freeform: Shape 7") = "e" 
      .Item("Freeform: Shape 9") = "f" 
      ' set forecolor for each shape depending on corresponding slicer actual selected state 
      For Each sShape In .Keys 
       Target.Parent.Shapes(sShape).Fill.ForeColor.RGB = IIf(_ 
        Target.Parent.Parent.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems(.Item(sShape)).Selected, _ 
        vbGreen, _ 
        RGB(205, 192, 176) _ 
       ) 
      Next 
     End With 
    End If 
End Sub 

Или даже вы можете использовать вложенные массивы:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) 
    Dim aShape 
    If Target.Name = "PivotTable4" Then 
     ' loop through shapes using array populated by nested arrays with shape/slicer name pairs 
     For Each aShape In Array(_ 
      Array("Freeform: Shape 6", "a"), _ 
      Array("Freeform: Shape 15", "b"), _ 
      Array("Freeform: Shape 11", "c"), _ 
      Array("Freeform: Shape 12", "d"), _ 
      Array("Freeform: Shape 7", "e"), _ 
      Array("Freeform: Shape 9", "f") _ 
     ) 
      ' set forecolor for the shape depending on the slicer actual selected state 
      Target.Parent.Shapes(aShape(0)).Fill.ForeColor.RGB = IIf(_ 
       Target.Parent.Parent.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems(aShape(1)).Selected, _ 
       vbGreen, _ 
       RGB(205, 192, 176) _ 
      ) 
     Next 
    End If 
End Sub 

ли не тестировался, так как у меня не было такой структуры данных, если я верно понимаю, что вы хотели, что должно работать.

Обратите внимание, что это не лучший способ полагаться на ActiveWorkbook и ActiveSheet глобальных объектов. Я изменил ActiveWorkbook с Target.Parent.Parent и ActiveSheet с Target.Parent.

Answer 2

Спасибо @omegastripes, .item не допускается, если так добавили уаг д, и она работала

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) 
    Dim sShape 
    Dim d 
    If Target.Name = "PivotTable4" Then 
     ' instantiate dictionary 
     Set d = CreateObject("Scripting.Dictionary") 
     With d 
      ' fill the dict with shape names as keys and corresponding slicer names as values 
      .Item("Freeform: Shape 6") = "a" 
      .Item("Freeform: Shape 15") = "b" 
      .Item("Freeform: Shape 11") = "c" 
      .Item("Freeform: Shape 12") = "d" 
      .Item("Freeform: Shape 7") = "e" 
      .Item("Freeform: Shape 9") = "f" 
      ' replace each slicer name with it's actual selected state 
      For Each sShape In .Keys 
       d.Item(sShape) = ActiveWorkbook.SlicerCaches("Slicer_Site_work_being_carried_out").SlicerItems(.Item(sShape)).Selected 
      Next 
      ' set forecolor for each shape individually 
      For Each sShape In .Keys 
       With ActiveSheet.Shapes(sShape).Fill.ForeColor 
        If d.Item(sShape) Then 
         .RGB = vbGreen 
        Else 
         .RGB = RGB(205, 192, 176) 
        End If 
       End With 
      Next 
     End With 
    End If 
End Sub