Select shapes within a range and align them - vba

Question

I want to write a function where I can select one shape after which a macro aligns all the shapes that are within a 'short range' of the selected shape.
Therefore I wrote the following code that selects all the object within a range:
Sub Shape_Dimensions()
Dim L As Long
Dim T As Long
Dim H As Long
Dim W As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
L = .ShapeRange.Left
T = .ShapeRange.Top
H = .ShapeRange.Height
W = .ShapeRange.Width
Else
MsgBox "You have not selected an OBJECT in PowerPoint to dimension."
Exit Sub
End If
End With
'Set range for selection
TopRange = L + 30
DownRange = T + H + 20
'Left and right are 0 - 600
End Sub
Now the final step I want to take is select all shapes that are within the top range and down range and align them with the top of the selected box. Any thoughts on how I should proceed?

Answer 1

Sub Shape_Align()
Dim L As Long
Dim T As Long
Dim H As Long, TopRange As Long, DownRange As Long
Dim W As Long, s As Shape, n As String
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
L = .ShapeRange.Left
T = .ShapeRange.Top
H = .ShapeRange.Height
W = .ShapeRange.Width
n = .ShapeRange.Name
Else
MsgBox "You have not selected an OBJECT in PowerPoint to dimension."
Exit Sub
End If
End With
'Set range for selection
TopRange = L + 30
DownRange = T + H + 20
'Left and right are 0 - 600
For Each s In ActiveWindow.View.Slide.Shapes
If s.Name <> n Then
'in scope for lining up?
If Abs(s.Top - T) < 60 Then
s.Top = T
End If
End If
Next s
End Sub