Another of my favourite little pieces of code, this one lets you select shapes on a slide, by a property, for example, type, shape, width, colour, based on an initial selection.
On some of my regularly used slides, I have over 150 shapes that are all identical, they have names so I could address them individually (and in fact I do in another scenario), but if I colour them to show a ‘heatmap’, but want to say change the text colour of only shapes that are one particular colour. Then I’ll want to select those shapes only.
Sub selectSameShape() Dim bob As Variant Dim shp As Shape Dim sld As Slide Dim x As Integer x = 1 Do While Windows(x).Presentation.Name <> ActivePresentation.Name x = x + 1 Loop bob = Windows(x).Selection.ShapeRange.Width Set sld = ActivePresentation.Slides(Windows(x).Selection.SlideRange.SlideIndex) For Each shp In sld.Shapes If shp.Width = bob Then shp.Select Replace:=False End If Next End Sub
So, what’s going on here? Firstly, we need to get the window index of the active presentation. This ensures that if you have more than one powerpoint open, that the one that we’re working on, is the one we make changes to.
We do this by looping through all of the windows until we get to the one that has the same name as the active presentation. Why? Because PPT selection is a window method, not an activepresentation method. I don’t entirely understand this, but I can work with it.
x = 1 Do While Windows(x).Presentation.Name <> ActivePresentation.Name x = x + 1 Loop
Next we want to set the match criteria. In this case, I wanted all shapes the same width as the current selected shape. I’ve put this in the object ‘bob’. This could just as easily be background colour, left, top, height, autoshape type, etc. But it’s important to remember, that we must also test the shapes as we loop against this, against the same property (otherwise it might never match any!)
bob = Windows(x).Selection.ShapeRange.Width
Next, we set the active slide, into a variable, so that we can loop over the object for all shapes contained within it.
Set sld = ActivePresentation.Slides(Windows(x).Selection.SlideRange.SlideIndex)
Now we have it contained in a variable, this sld object contains the shapes object, which represents all shapes on the slide. We simply loop over these and test against our property of interest.
For Each shp In sld.Shapes If shp.Width = bob Then 'remember, bob is the original selected shape's width shp.Select Replace:=False 'select, and add to selection, don't replace End If Next
This macro has saved me huge amounts of time when editing organisation heirarchies, heatmaps, and visualisations built in Powerpoint.