Consulting

Results 1 to 3 of 3

Thread: Snap to Shape

  1. #1

    Snap to Shape

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •