TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub StackEmDanO()
Dim oShapes As Shapes
Dim oSh As Shape
Dim oSl As Slide
Dim x As Long
Dim aShapes() As Shape
For Each oSl In ActivePresentation.Slides
' Redimension the array to hold the maximum number of shapes for this slide
ReDim aShapes(1 To oSl.Shapes.Count) As Shape
x = 1
' Add the shapes we want to affect to the array of shapes
' in the order we want them stacked
' Pictures
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
Set aShapes(x) = oSh
x = x + 1
End If
Next ' shape
' Textboxes
For Each oSh In oSl.Shapes
If oSh.Type = msoTextBox Then
Set aShapes(x) = oSh
x = x + 1
End If
Next ' shape
' Lines that have an arrowhead
For Each oSh In oSl.Shapes
If oSh.Type = msoLine Then
If oSh.Line.EndArrowheadStyle <> msoArrowheadNone _
Or _
oSh.Line.BeginArrowheadStyle <> msoArrowheadNone Then
Set aShapes(x) = oSh
x = x + 1
End If
End If
Next ' shape
' Now bring each shape in the array to the top
' in order
For x = 1 To UBound(aShapes)
If Not aShapes(x) Is Nothing Then
aShapes(x).ZOrder (msoBringToFront)
Debug.Print aShapes(x).Name
End If
Next
Next ' slide
End Sub