PDA

View Full Version : Solved: Adding shapes to current selection



TrippyTom
01-12-2007, 05:37 PM
I'm trying to simulate a "magic wand" effect on shapes in PowerPoint. I want my macro to select any shape on the current slide that matches the currently selected shape's fill color.

Here's my code:

'Fill Color
If cb_FillColor = True Then
myFillColor = ActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Fill.ForeColor.RGB = myFillColor Then
shp.Select
End If
Next
End If


However, it's not making the selection add to itself. It's just looping through the shapes one by one and ending on the last one that matches the criteria. Is there a way to ADD to a selection as I loop through the shapes?

FYI: cb_FillColor is the checkbox name on a form I'm using.

TrippyTom
01-12-2007, 06:18 PM
I figured it out. In case anyone wants to know the same thing, here's my fix:

'Fill Color
If cb_FillColor = True Then
myFillColor = ActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Fill.ForeColor.RGB = myFillColor Then
shp.Select Replace:=False
End If
Next
End If


Once I'm all done with my macro I will post it.

TrippyTom
01-16-2007, 11:48 AM
ugh... I wish we could UNSOLVE posts.

I have another problem. It seems to be selecting any shape that uses the default color as well as the currently selected shape's fill color. Is there any way to fix this? It works fine if the shape is any other color, but if it's the default color, it's selecting things that don't have a fill color at all. Very strange.

'Fill Color
If cb_FillColor = True Then
myFillColor = ActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Fill = msoTrue Then
If shp.Fill.ForeColor.RGB = myFillColor Then
shp.Select Replace:=False
End If
End If
Next
End If

TrippyTom
01-16-2007, 12:00 PM
Why do I always find the solution to my question like 5 minutes after I make the post? This is a terrible habit I'm making.

This fixed my problem. :thumb

'Fill Color
If cb_FillColor = True Then
myFillColor = ActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
'If ActiveWindow.Selection.ShapeRange.Fill.Visible = msoFalse Then
If shp.Fill.Visible = msoFalse Then
Resume Next
ElseIf shp.Fill.ForeColor.RGB = myFillColor Then
shp.Select Replace:=False
End If
Next
End If

TrippyTom
01-16-2007, 12:38 PM
Ok, below is my final code. I made a userform that looks like the attached picture. I made them option buttons because if the user chose more than one it would produce strange results.

Sub MagicWand()
'simulates the Magic Wand tool in Adobe Illustrator to select shapes with similar:
'Fill color, Line color, Line weight, Font color, or Opacity
frm_MagicWand.Show
End Sub

This is the code on the form itself:

Private Sub btn_All_Click()
cb_FillColor = True
cb_LineColor = True
cb_LineWeight = True
cb_Opacity = True
cb_FontColor = True
End Sub
Private Sub btn_Cancel_Click()
Unload Me
End Sub
Private Sub btn_None_Click()
cb_FillColor = False
cb_LineColor = False
cb_LineWeight = False
cb_Opacity = False
cb_FontColor = False
End Sub
Private Sub btn_OK_Click()
On Error Resume Next
Dim myFillColor As Variant
Dim myLineColor As Variant
Dim myLineWeight As Variant
Dim myFontColor As Variant
Dim myOpacity As Variant
Dim shp As Shape
Dim mySlide As Integer
mySlide = ActiveWindow.View.Slide.SlideIndex
'Fill Color
If op_FillColor = True Then
myFillColor = ActiveWindow.Selection.ShapeRange.Fill.ForeColor.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Fill.Visible = msoFalse Then
Resume Next
ElseIf shp.Fill.ForeColor.RGB = myFillColor Then
shp.Select Replace:=False
End If
Next
End If
'Line Color
If op_LineColor = True Then
myLineColor = ActiveWindow.Selection.ShapeRange.Line.ForeColor.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Line.Visible = msoFalse Then
Resume Next
ElseIf shp.Line.ForeColor.RGB = myLineColor Then
shp.Select Replace:=False
End If
Next
End If
'Line Weight
If op_LineWeight = True Then
myLineWeight = ActiveWindow.Selection.ShapeRange.Line.Weight
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Line.Visible = msoFalse Then
Resume Next
ElseIf shp.Line.Weight = myLineWeight Then
shp.Select Replace:=False
End If
Next
End If
'Opacity
If op_Opacity = True Then
myOpacity = ActiveWindow.Selection.ShapeRange.Fill.Transparency
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If shp.Fill.Visible = msoFalse Then
Resume Next
ElseIf shp.Fill.Transparency = myOpacity Then
shp.Select Replace:=False
End If
Next
End If
'Font Color
If op_FontColor = True Then
myFontColor = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Color.RGB
For Each shp In ActivePresentation.Slides(mySlide).Shapes.Range
If Not shp.HasTextFrame Then
Resume Next
ElseIf shp.TextFrame.TextRange.Font.Color.RGB = myFontColor Then
shp.Select Replace:=False
End If
Next
End If

Unload Me
End Sub