I think the issue was a logic error in the code
I changed to an array since it's easier to track
Not .Fill.Visible seems to work
Even with the macro that was working I kept getting an extra shape selected (possibly caused by using a collection??) - Look at Shape 2
Capture.JPG
This is a little wordy, but I like to be very specific defining If/Then tests and not try to squeeze it into a single logical statement with lots or ANDs and ORs
Option Explicit
Sub SelectByColor()
Dim shpSelected As Shape
Dim shp As Shape
Dim aryShapes() As Long
Dim i As Long
If ActiveWindow.Selection.Type <> ppSelectionShapes And ActiveWindow.Selection.Type <> ppSelectionText Then
MsgBox "Please select a shape"
Exit Sub
End If
If ActiveWindow.Selection.ShapeRange.Count > 1 Then
MsgBox "Please select only one shape"
Exit Sub
End If
Set shpSelected = ActiveWindow.Selection.ShapeRange(1)
If shpSelected.Type = msoPicture Or shpSelected.AutoShapeType = msoShapeMixed Then
MsgBox "Sorry! For pictures and lines or connectors no fill color is defined"
Exit Sub
End If
ReDim aryShapes(0 To 0)
For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
Set shp = ActiveWindow.Selection.SlideRange.Shapes(i)
With shp
If .Type = msoPicture Then GoTo NextShape
If Not .Visible Then GoTo NextShape
If Not .Fill.Visible And shpSelected.Fill.Visible Then GoTo NextShape
If .Fill.Visible And Not shpSelected.Fill.Visible Then GoTo NextShape
If Not .Fill.Visible And Not shpSelected.Fill.Visible Then
aryShapes(UBound(aryShapes)) = i
ReDim Preserve aryShapes(0 To UBound(aryShapes) + 1)
GoTo NextShape
End If
If .Fill.ForeColor = shpSelected.Fill.ForeColor Then
aryShapes(UBound(aryShapes)) = i
ReDim Preserve aryShapes(0 To UBound(aryShapes) + 1)
GoTo NextShape
End If
End With
NextShape:
Next i
If UBound(aryShapes) = 0 Then
MsgBox "No matching shape found"
Else
ReDim Preserve aryShapes(0 To UBound(aryShapes) - 1)
ActiveWindow.Selection.Unselect
ActiveWindow.Selection.SlideRange(1).Shapes.Range(aryShapes).Select
End If
End Sub
To remove all fills
Sub RemoveFills() Dim oShape As Shape
For Each oShape In ActivePresentation.Slides(1).Shapes
oShape.Fill.Visible = msoFalse
Next
End Sub