View Single Post
  #7  
Old 07-07-2005, 23:42
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Select Same Color

I was just working on another script for deleting objects of the same color, and thought, you know with a a few changes this could be made to work to select objects of the same color.

If you select a single shape, then run this script it will select all shapes with the same color and create a selection, you can then change the color or delete them. Hope you find it useful.

Code:
Sub SelectSameColor()

Dim os As Shape, s As Shape
Dim sr As New ShapeRange

If ActiveSelection.Shapes.Count = 0 Then
    MsgBox "Please select an object.", vbOKOnly
    Exit Sub
ElseIf ActiveSelection.Shapes.Count > 1 Then
    MsgBox "Please select only one object.", vbOKOnly
    Exit Sub
ElseIf ActiveSelection.Shapes.Count = 1 Then
    Set os = ActiveShape
End If

For Each s In ActivePage.Shapes
    If s.StaticID <> os.StaticID Then
        If s.Fill.UniformColor.IsSame(os.Fill.UniformColor) Then sr.add s
    End If
Next s

sr.add os
sr.CreateSelection
    
End Sub
Reply With Quote