troubleshooting Question

Manipulating individual shapes within grouped shapes in PowerPoint using VBA?

Avatar of Bryce Bassett
Bryce BassettFlag for United States of America asked on
Microsoft OfficeMicrosoft PowerPointVBA
9 Comments1 Solution1176 ViewsLast Modified:
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

'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
Jamie Garroch (MVP)
PowerPoint Technical Consultant

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 9 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 9 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros