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
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”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.