Snap to Shape

[magnel]

Hello,

I am searching for a code which can make two shapes stick to each other in PPT.
Please can someone help me with a code to stick two or more selected shapes together.

24154

Thanks

[John Wilson]

By "stick to ... " Do you just mean align as in the diagram?

TRY:


Sub stickem_V()
Dim rayShp() As Shape
Dim L As Long
ReDim rayShp(1 To ActiveWindow.Selection.ShapeRange.Count)
For L = 1 To ActiveWindow.Selection.ShapeRange.Count
Set rayShp(L) = ActiveWindow.Selection.ShapeRange(L)
Next L
Call SortByTop(rayShp)
For L = 2 To UBound(rayShp)
With rayShp(L - 1)
rayShp(L).Top = .Top + .Height
End With
Next L
End Sub
Sub SortByTop(Arrayin As Variant)
Dim b_Cont As Boolean
Dim lngCount As Long
Dim vSwap As Shape
Do
b_Cont = False
For lngCount = LBound(Arrayin) To UBound(Arrayin) - 1
If Arrayin(lngCount).Top > Arrayin(lngCount + 1).Top Then
Set vSwap = Arrayin(lngCount)
Set Arrayin(lngCount) = Arrayin(lngCount + 1)
Set Arrayin(lngCount + 1) = vSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
'release objects
Set vSwap = Nothing
End Sub

[magnel]

Wow... this works perfect. Thank you so much John, you are awesome.