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 Integer
Dim iconpicked As String
Dim myshape As Shape
Dim currentslide As Slide
Dim refindleft As Single
Dim refindtop As Single
Dim myMSshape As Shape
Dim farthestleft As Single
Dim myswoosh As Shape

iconpicked = "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 later
findtop = myshape.Top 'store top edge of imported EMF so we can refind it later

myshape.Ungroup 'convert EMF to Microsoft Office drawing object so we can manipulate it

'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 left most shape will be the swoosh in every case.  Iterate the shapes to identify it.
farthestleft = 1200
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

MsgBox "The swoosh is named " & myswoosh.Name & vbCrLf & " located at left = " & myswoosh.Left & vbCrLf & " filled with color " & myswoosh.Fill.ForeColor

myswoosh.Fill.ForeColor.RGB = RGB(255, 0, 0)

End Sub

Open in new window

nuclear.emf
Bryce BassettFreelance VBA programmerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jamie GarrochPowerPoint Consultant & DeveloperCommented:
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 projects
Option Explicit

Sub recolorswoosh()

Dim x As Long ' was Integer but object collections use Long
Dim iconpicked As String
Dim myshape As Shape
'Dim currentslide As Slide no longer needed
'Dim refindleft As Single no longer needed
'Dim refindtop As Single no longer needed
Dim myMSshape As Shape
'Dim farthestleft As Single no longer needed
Dim myswoosh As Shape
' These were undefined (found by using Option Explicit) but are no longer needed
' Dim findleft As Single, findtop As Single

iconpicked = "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 EMF
Set 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": Next
End With

MsgBox "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 brand
myswoosh.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1

End Sub

Open in new window


And here it is all tidied up:

Option Explicit

Sub 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 = msoThemeColorAccent1
End Sub

Open in new window

0
Jamie GarrochPowerPoint Consultant & DeveloperCommented:
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 Sub

Sub 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 If
End Sub

Open in new window


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.
0
Bryce BassettFreelance VBA programmerAuthor Commented:
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!
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Jamie GarrochPowerPoint Consultant & DeveloperCommented:
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?)

iconpicked = myPath & "\nuclear.emf"

Open in new window


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.
0
Bryce BassettFreelance VBA programmerAuthor Commented:
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.
0
Jamie GarrochPowerPoint Consultant & DeveloperCommented:
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...
0
Jamie GarrochPowerPoint Consultant & DeveloperCommented:
Given hiding the placeholders doesn't help (PowerPoint makes the first empty one visible again and inserts the picture), the easiest way I can think of is to create a temporary slide without picture-compatible placeholders, insert the EMF there, copy it to the clipboard, delete the temporary slide and then paste it to the original target slide.

Sub recolorswoosh3()
  Dim x As Long
  Dim iconpicked As String
  Dim myshape As Shape, myMSshape As Shape, myswoosh As Shape
  Dim curSlide As Long
  
  iconpicked = "C:\Test\nuclear.emf"
  
  curSlide = ActiveWindow.View.Slide.SlideIndex
  
  With ActivePresentation.Slides
    ' add a new slide without picture palceholders
    With .AddSlide(curSlide + 1, ActivePresentation.SlideMaster.CustomLayouts(1))
      ' insert the EMF picture from the file system, copy it to the clipboard and then delete it
      With .Shapes.AddPicture(iconpicked, msoFalse, msoTrue, 200, 200)
        .Copy
        .Delete
      End With
      ' delete the temporary slide and paste the EMF to the original target slide
      .Delete
      Set myshape = ActivePresentation.Slides(curSlide).Shapes.Paste(1)
    End With
  End With
    
  ' 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 = msoThemeColorAccent1
End Sub

Open in new window


Note too that there is a big assumption with any code that uses ActivePresentation or ActiveView and that's that the presentation is (a) editable, not read only or in protected view and (b) that the view is of a slide and not the Notes pane, Thumbnails pane, Master view, the annoying "cursor in-between slide thumbnails state" etc. etc.

But that's a whole different topic!
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bryce BassettFreelance VBA programmerAuthor Commented:
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.
1
Bryce BassettFreelance VBA programmerAuthor Commented:
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.
1
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.