Matching shapes of same styles and including them in a collection

[juanbolas]

Hi all. Again thanks for all the valuable help!

I'm trying to get an old piece of code to work that I had scavenged and extensively modified.

It matches the characteristics of the Source and Target Shapes and if they all mad it adds them to a collection which it then selects so you can change all the shapes as you wish.

I was introducing handling of nested groups and realized this. If anyone has a good Idea on how to best tackle this, great!

The pronblem is that its not doing anything now.


Option Private Module
Option Explicit


Dim oShape As Shape
Dim shapeCollection() As String
Dim oShapeTarget As Shape
Dim ShapeCounter As Integer

Set oShape = ActiveWindow.Selection.ShapeRange(1)
ReDim Preserve shapeCollection(0)

shapeCollection(0) = oShape.Name
ShapeCounter = 1


For Each oShapeTarget In ActiveWindow.View.slide.Shapes

With oShapeTarget
If .Type = oShape.Type _
And .Type <> msoPlaceholder _
And .line.ForeColor = oShape.line.ForeColor _
And .line.DashStyle = oShape.line.DashStyle _
And .line.Weight = oShape.line.Weight _
And .line.Visible = True _
And .Fill.ForeColor = oShape.Fill.ForeColor _
And .Fill.Visible = True _
And .Height = oShape.Height _
And .Width = oShape.Width _
And .HasTextFrame = oShapeTarget.HasTextFrame _
And .TextFrame.HasText = oShape.TextFrame.HasText _
And .TextFrame.textRange.Font.Name = oShape.TextFrame.textRange.Font.Name _
And .TextFrame.textRange.Font.Size = oShape.TextFrame.textRange.Font.Size _
And .TextFrame.textRange.Font.color = oShape.TextFrame.textRange.Font.color _
Then


ReDim Preserve shapeCollection(1 + ShapeCounter)
shapeCollection(ShapeCounter) = oShapeTarget.Name
ShapeCounter = ShapeCounter + 1

End If
End With
Next oShapeTarget


ActiveWindow.View.slide.Shapes.range(shapeCollection).Select


End Sub




Thanks is advance