Manipulating individual shapes within grouped shapes in PowerPoint using VBA?
I began by asking about VBA in PowerPoint to recolor certain parts of a bitmap (see previous question here), but Jamie Garroch suggested a much better approach, using a vector image which can be manipulated more easily.
My code below imports an EMF file, converts it to MS drawing object, then locates a particular shape within the group so I can recolor it. Any suggestions to make this more efficient, since I may need to recolor dozens of icons across multiple slides in a deck? Thanks!
Sub recolorswoosh()Dim x As IntegerDim iconpicked As StringDim myshape As ShapeDim currentslide As SlideDim refindleft As SingleDim refindtop As SingleDim myMSshape As ShapeDim farthestleft As SingleDim myswoosh As Shapeiconpicked = "C:\Test\nuclear.emf"Set currentslide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)Set myshape = currentslide.Shapes.AddPicture(FileName:=iconpicked, linktofile:=msoFalse, _ savewithdocument:=msoTrue, Left:=200, Top:=200)findleft = myshape.Left 'store left edge of imported EMF so we can refind it laterfindtop = myshape.Top 'store top edge of imported EMF so we can refind it latermyshape.Ungroup 'convert EMF to Microsoft Office drawing object so we can manipulate it'find the converted shape by matching stored coordinatesFor Each myshape In currentslide.Shapes If myshape.Left = findleft And myshape.Top = findtop Then Set myMSshape = myshape Exit For End IfNext'the left most shape will be the swoosh in every case. Iterate the shapes to identify it.farthestleft = 1200For x = 1 To myMSshape.GroupItems.count Set myshape = myMSshape.GroupItems(x) If myshape.Left < farthestleft Then Set myswoosh = myshape farthestleft = myshape.Left End IfNext xMsgBox "The swoosh is named " & myswoosh.Name & vbCrLf & " located at left = " & myswoosh.Left & vbCrLf & " filled with color " & myswoosh.Fill.ForeColormyswoosh.Fill.ForeColor.RGB = RGB(255, 0, 0)End Sub
I've made a whole bunch of suggestions in the overly-commented code below:
' Always put this line at the top of every module as it'll really help you debug projectsOption ExplicitSub recolorswoosh()Dim x As Long ' was Integer but object collections use LongDim iconpicked As StringDim myshape As Shape'Dim currentslide As Slide no longer needed'Dim refindleft As Single no longer needed'Dim refindtop As Single no longer neededDim myMSshape As Shape'Dim farthestleft As Single no longer neededDim myswoosh As Shape' These were undefined (found by using Option Explicit) but are no longer needed' Dim findleft As Single, findtop As Singleiconpicked = "C:\Test\nuclear.emf"'Set currentslide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)'Set myshape = currentslide.Shapes.AddPicture(FileName:=iconpicked, linktofile:=msoFalse, _ savewithdocument:=msoTrue, Left:=200, Top:=200)' Above can be simplified to:Set myshape = ActiveWindow.View.Slide.Shapes.AddPicture(FileName:=iconpicked, linktofile:=msoFalse, _ savewithdocument:=msoTrue, Left:=200, Top:=200)' No longer needed:'findleft = myshape.Left 'store left edge of imported EMF so we can refind it later'findtop = myshape.Top 'store top edge of imported EMF so we can refind it later'find the converted shape by matching stored coordinates'For Each myshape In currentslide.Shapes' If myshape.Left = findleft And myshape.Top = findtop Then' Set myMSshape = myshape' Exit For' End If'Next' The above part can be simplified by creating a reference to the MS drawing group at the time it's converted from EMFSet myMSshape = myshape.Ungroup(1) 'convert EMF to Microsoft Office drawing object so we can manipulate it'the left most shape will be the swoosh in every case. Iterate the shapes to identify it.'farthestleft = ActivePresentation.PageSetup.SlideWidth ' was 1200 but not sure why?'For x = 1 To myMSshape.GroupItems.Count' Set myshape = myMSshape.GroupItems(x)' If myshape.Left < farthestleft Then' Set myswoosh = myshape' farthestleft = myshape.Left' End If'Next x' The above part could be simplified to find the swoosh using its layer,' which is also constant at 2, above the AutoShapeXX object.Set myswoosh = myMSshape.GroupItems(2)' You could optionally delete the AutoShapeXX object which is always created' as an invisble boundary shape in the lowest layer when ungrouping an EMF.myMSshape.GroupItems(1).Delete' You could optionally name the group and items in it to help identification' in the Selection Pane for a user.With myMSshape x = InStrRev(iconpicked, "\") .Name = "Icon : " & Mid(iconpicked, x + 1, Len(iconpicked) - x) .GroupItems(1).Name = "swoosh" For x = 2 To .GroupItems.Count: .GroupItems(x).Name = "icon element": NextEnd WithMsgBox "The swoosh is named " & myswoosh.Name & vbCrLf & " located at left = " & myswoosh.Left & vbCrLf & " filled with color " & myswoosh.Fill.ForeColor' Recolour to theme to be on brandmyswoosh.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1End Sub
Option ExplicitSub recolorswoosh2() Dim x As Long Dim iconpicked As String Dim myshape As Shape, myMSshape As Shape, myswoosh As Shape iconpicked = "C:\Test\nuclear.emf" iconpicked = myPath & "\nuclear.emf" ' insert the EMF picture from the file system Set myshape = ActiveWindow.View.Slide.Shapes.AddPicture(iconpicked, msoFalse, msoTrue, 200, 200) ' create a reference to the MS drawing group at the time it's converted from EMF Set myMSshape = myshape.Ungroup(1) ' find the swoosh using its layer which is constant at 2 Set myswoosh = myMSshape.GroupItems(2) ' delete the AutoShapeXX object myMSshape.GroupItems(1).Delete ' name the group and items in it With myMSshape x = InStrRev(iconpicked, "\") .Name = "Icon : " & Mid(iconpicked, x + 1, Len(iconpicked) - x) .GroupItems(1).Name = "swoosh" For x = 2 To .GroupItems.Count: .GroupItems(x).Name = "icon element": Next End With ' Recolour to theme to be on brand myswoosh.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1End Sub
And as you may want to process multiple shapes, you need to change the declaration of the above sub and call it from a second procedure like this:
Sub recolorswoosh2(oShp As Shape)...End SubSub RecolorIcons() Dim oSld As Slide Dim oShp As Shape For Each oSld In ActivePresentation.Slides For Each oShp In oSld.Shapes 'If oShp meets criteria xyz then ' recolorswoosh2 oShp 'End If Next End IfEnd Sub
You'll need to work out how to identify the icons, perhaps by name, safer is to use .Tags which are not editable via the PowerPoint UI by a user and can be added to a shape at the point it's inserted programmatically.
Bryce Bassett
ASKER
Thanks, Jamie. This is much slicker.
The reason for my convoluted method of locating the swoosh (left-most shape) within the group was that I'll be dealing with a library of several hundred of these icons. How can we be certain the swoosh will always be GroupItem(2)? Is there some instruction about ordering the shapes that I need to give to my design group as they create these in AI, to assure this is consistent?
I notice the AutoShapeXX that shows up when I ungroup the EMF. Seems to be some sort of extra container. I like the idea of deleting it, but is there a particular advantage other than keeping things tidy? Again, are we certain it will always be GroupItem(1)?
Finally, I was planning to name the shapes when imported but will go with your suggestion to use tags so the code can find them for future recoloring.
Thanks!
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
Jamie Garroch (MVP)
oops - I left one line of test code in my tidied up routine. This should be deleted: (if a moderator is reading, please could you delete it from the line 9 in the second code block of post ID: 42043209?)
Regarding group item 2. Whenever a WMF (or EPS) file is ungrouped the first time, it's converted to the native MSO vector format, as a group of shapes. The element order of the original WMF vector graphic will be retained so I assumed (maybe wrongly) that your design team will ensure that the swoosh will always be the element in the backmost layer. It's on layer 2 because the ungroup-to-convert process creates an unwanted shapes named AutoShape XX in the backmost layer of the group. This shape (which is equal in size to the boundary of all other shapes in the group) isn't normally needed and hence can be deleted. It's useful in my vicons product because all icons must occupy the same square area to retain their family look and feel so resizing them based on the invisible AutoShape is useful when the icon is not square.
When I coded this add-in I relied on these EPS to MSO conversion behaviours and it didn't fail in this respect for the 660 icons, each of various numbers of layers.
Bryce Bassett
ASKER
Thanks for the explanation. I do believe the swoosh will always be the backmost layer, but I was worried that more complex icons might have an inconsistent number of icon elements on top of that. I'll experiment to be sure.
Could I piggyback one more related question? If there happens to be an unfilled picture placeholder on the slide at the time I insert the icon using the above method, it sticks the icon into that placeholder, and then you can't ungroup it so the rest of the code fails. That's an annoying default PowerPoint behavior as far as I've been able to tell, to stick an inserted picture into the next empty placeholder. How do I avoid this and place my inserted icon on the slide rather than into the placeholder? Thanks.
Jamie Garroch (MVP)
It doesn't matter how many objects will be on top because PowerPoint indexes from the back to the front so the backmost layer is always index 1 (or 2) if you keep the AutoShape.
Regarding the placeholder thing, yes, I came across that when developing another add-in. I can't recall what I did so let me go dig around in some code...
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
Thanks for all the help! I've had to resort to this kind of workaround before. We may be able to train users, but I'll use this if I have to. I'm good with those assumptions since my toolbar is being used when they are actively editing the presentation. I have a subroutine I call at the top of almost every procedure to deal with the in between slides issue and make sure one slide is selected, so no worries there.
Bryce Bassett
ASKER
And yes, I confirmed that the swoosh is always #2 before deletion of the AutoFrame, even when some of these come in with dozens of icon elements. Very helpful.
Open in new window
And here it is all tidied up:
Open in new window