TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
Sub DoThingsWithShapesInPictures() ' Generic code that can be adapted to various purposes ' This locates each picture shape in each slide in the current presentation ' It ungroups the picture then performs some series of steps on each shape within the ' ungrouped picture ' ' Possible problems: ungrouped pictures may still contain groups; these would be ignored Dim oSlides As Slides Dim oSlide As Slide Dim oShapes As Shapes Dim oSh As Shape Dim oShRng As ShapeRange Dim x As Long Set oSlides = ActivePresentation.Slides For Each oSlide In oSlides Set oShapes = oSlide.Shapes For Each oSh In oShapes ' Is it a picture? If oSh.Type = msoPicture Then ' ungroup it Set oShRng = oSh.Ungroup ' deal with each shape For x = 1 To oShRng.Count Set oSh = oShRng(x) If oSh.HasTextFrame Then If oSh.TextFrame.HasText Then oSh.TextFrame.TextRange.Font.Name = "Arial" oSh.TextFrame.TextRange.Font.Bold = msoTrue End If End If Next x ' regroup the graphic Set oSh = oShRng.Group End If Next oSh Next oSlide End Sub