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.
SnaptoShape.jpg
Thanks
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.
SnaptoShape.jpg
Thanks
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
John Wilson
Microsoft PowerPoint MVP
Amazing Free PowerPoint Tutorials
http://www.pptalchemy.co.uk/powerpoi...tutorials.html
Wow... this works perfect. Thank you so much John, you are awesome.