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