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



































