TPE

http://bayanbox.ir/view/263405954590585756/2mobile.png

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