Consulting

Results 1 to 8 of 8

Thread: Help with alignment of shapes for our "standard" presentation template...

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location

    Help with alignment of shapes for our "standard" presentation template...

    See the attached deck. This is what the finished product should look like. Decks can be up to 350 slides.

    The chart/table combos are picture objects that are sometimes placed in random positions on the slide template. Those picture objects need to be aligned with the rectangle shape object on each slide.

    My goal is to automate the alignment of the picture objects with the shape objects. I have code that correctly gets the job done...for about 60% of the slides. Something is going awry for the other 40% and I don't know what it is.

    Any guidance would be hugely appreciated!!

    Here is my objective:

    In the finished deck, each slide will have EITHER 2 or 3 shapes:

    Title 1 + Picture 2

    OR

    Title 1 + Picture 2 + Rectangle 2

    Constants for 3-shape slides:
    • Every slide will have 3 shapes = ‘Title 1’, ‘Picture 2’, ‘Rectangle 2’
    • Rectangle 2 DOESN'T NEED TO BE POSITIONED WITH THIS MACRO and will ALWAYS be in one of two EXACT positions and one of two EXACT sizes = Tall, slim rectangle on right side of slide

    Short, wide rectangle on bottom of slide
    Variables:
    • Picture 2 size can vary, but not by much


    Need a macro that will:

    • For every slide in presentation
    • IF Rectangle 2 is on the RIGHT SIDE of slide, align Picture 2 with MIDDLE of Rectangle 2 WITHOUT REPOSITIONING RECTANGLE 2
      • I already wrote the code for this piece, cleaned up and perfected by John Wilson. See code snippet below

    • IF Rectangle 2 is at the BOTTOM of the slide, align VERTICAL CENTERS of Rectangle 2 and Picture 2 WITHOUT REPOSITIONING RECTANGLE 2
    • In either scenario, need the macro to put a (somewhat) uniform amount of space between Picture 2 and Rectangle 2

    Test Positioning Macro.pptx


    Existing code that takes care of the 1st scenario (where Rectangle 2 is on the right side of the slide):

    Sub Aligner_MIDDLE() 'This aligns one shape's middle to another shape's middle, WITHOUT repositioning the shapes on the slide  John Wilson cleaned up my code
    Dim osl As Slide
    Dim osh As Shape
    Dim osh1 As Shape
    Dim osh2 As Shape
    Set osl = ActiveWindow.Selection.SlideRange(1)
    For Each osl In ActivePresentation.Slides
        For Each osh In osl.Shapes
            If osh.Name = "Rectangle 2" And osh.Height > 100 Then
                Set osh1 = osh
            End If
            If osh.Name = "Picture 2" Then
               Set osh2 = osh
            End If
       Next osh
       If Not osh1 Is Nothing And Not osh2 Is Nothing Then
            osh2.Top = osh1.Top + osh1.Height / 2 - osh2.Height / 2
       End If
    Next osl
    MsgBox "Macro has finished!" & vbCrLf & "", , "Done!"
    End Sub
    Last edited by Aussiebear; 04-27-2023 at 03:48 PM. Reason: Reduced the whitespace

  2. #2
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    If I say "pretty please with a cherry on top"?

  3. #3
    Well, I had a go at this and here is my solution. You can change the values of "horizontal_spacing" and "vertical_spacing" in the code to change the amount of space you want between the Picture2 and Rectangle2...

    Sub align_picture_to_rectangle()
    Dim horizontal_spacing As Single
    Dim vertical_spacing As Single
    Dim x_gap_calc As Single
    Dim y_gap_calc As Single
    Dim the_slide As Slide
    Dim the_shape As shape
    Dim the_rectangle As shape
    Dim the_picture As shape
    Dim slide_middle_x As Integer
    Dim slide_middle_y As Integer
    ' Set the horizontal spacing here, it is a percentage of slide width
    horizontal_spacing = 2
    ' Set the vertical spacing here, it is a percentage of slide height
    vertical_spacing = 1.5
    ' Get middle of the slide to check where the rectangle is
    slide_middle_x = ActivePresentation.PageSetup.SlideWidth / 2
    slide_middle_y = ActivePresentation.PageSetup.SlideHeight / 2
    ' Calcuate the spacing
    x_gap_calc = ActivePresentation.PageSetup.SlideWidth * (horizontal_spacing / 100)
    y_gap_calc = ActivePresentation.PageSetup.SlideHeight * (vertical_spacing / 100)
    ' Loop through each slide
    For Each the_slide In ActivePresentation.Slides
        Set the_rectangle = Nothing
        Set the_picture = Nothing
        ' Loop thorough each shape in slide
        For Each the_shape In the_slide.Shapes
            If the_shape.Name = "Rectangle 2" Then
                Set the_rectangle = the_shape
            End If
            If the_shape.Name = "Picture 2" Then
                Set the_picture = the_shape
            End If
                ' Check if rectangle and picture has been found
            If Not (the_rectangle Is Nothing) And Not (the_picture Is Nothing) Then
            ' Rectangle is on the right
                If the_rectangle.Left > slide_middle_x Then
                    ' Align picture on y axis to the rectangle center
                    the_picture.Top = the_rectangle.Top + (the_rectangle.Height / 2)
                    the_picture.Top = the_picture.Top - (the_picture.Height / 2)
                    ' Create the gap, move the picture left
                    the_picture.Left = the_rectangle.Left - the_picture.Width
                    the_picture.Left = the_picture.Left - x_gap_calc
                End If
                ' Rectangle is at the bottom
                If the_rectangle.Top > slide_middle_y Then
                    ' Align picture on x axis to the rectangle center
                    the_picture.Left = the_rectangle.Left + (the_rectangle.Width / 2)
                    the_picture.Left = the_picture.Left - (the_picture.Width / 2)
                    ' Create the gap, move the picture up
                    the_picture.Top = the_rectangle.Top - the_picture.Height
                    the_picture.Top = the_picture.Top - y_gap_calc
                End If
            End If
        Next
    Next
    End Sub
    Last edited by Aussiebear; 04-27-2023 at 03:58 PM. Reason: Reduced the whitespace
    Please see my Udemy course "PowerPoint VBA Macros and Coding Interactive Presentations"
    https://www.udemy.com/course/powerpoint-vba-macros/
    Send me a private message for a course coupon

  4. #4
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    This is perfect. I can't thank you enough

  5. #5
    Quote Originally Posted by venablest View Post
    Well, I had a go at this and here is my solution. You can change the values of "horizontal_spacing" and "vertical_spacing" in the code to change the amount of space you want between the Picture2 and Rectangle2...

    Sub align_picture_to_rectangle()
    
    
        Dim horizontal_spacing As Single
        Dim vertical_spacing As Single
        
        Dim x_gap_calc As Single
        Dim y_gap_calc As Single
    
    
        Dim the_slide As Slide
        Dim the_shape As shape
        Dim the_rectangle As shape
        Dim the_picture As shape
        
        Dim slide_middle_x As Integer
        Dim slide_middle_y As Integer
        
         ' Set the horizontal spacing here, it is a percentage of slide width
        horizontal_spacing = 2
         ' Set the vertical spacing here, it is a percentage of slide height
        vertical_spacing = 1.5
        
        ' Get middle of the slide to check where the rectangle is
        slide_middle_x = ActivePresentation.PageSetup.SlideWidth / 2
        slide_middle_y = ActivePresentation.PageSetup.SlideHeight / 2
        
        ' Calcuate the spacing
        x_gap_calc = ActivePresentation.PageSetup.SlideWidth * (horizontal_spacing / 100)
        y_gap_calc = ActivePresentation.PageSetup.SlideHeight * (vertical_spacing / 100)
    
    
    
    
        ' Loop through each slide
        For Each the_slide In ActivePresentation.Slides
        
            Set the_rectangle = Nothing
            Set the_picture = Nothing
        
            ' Loop thorough each shape in slide
            For Each the_shape In the_slide.Shapes
               
               If the_shape.Name = "Rectangle 2" Then
                    Set the_rectangle = the_shape
               End If
               If the_shape.Name = "Picture 2" Then
                    Set the_picture = the_shape
               End If
               
               ' Check if rectangle and picture has been found
               If Not (the_rectangle Is Nothing) And Not (the_picture Is Nothing) Then
               
                    ' Rectangle is on the right
                    If the_rectangle.Left > slide_middle_x Then
                        ' Align picture on y axis to the rectangle center
                        the_picture.Top = the_rectangle.Top + (the_rectangle.Height / 2)
                        the_picture.Top = the_picture.Top - (the_picture.Height / 2)
                        
                        ' Create the gap, move the picture left
                        the_picture.Left = the_rectangle.Left - the_picture.Width
                        the_picture.Left = the_picture.Left - x_gap_calc
                    End If
                    
                    ' Rectangle is at the bottom
                    If the_rectangle.Top > slide_middle_y Then
                        ' Align picture on x axis to the rectangle center
                        the_picture.Left = the_rectangle.Left + (the_rectangle.Width / 2)
                        the_picture.Left = the_picture.Left - (the_picture.Width / 2)
                        
                        ' Create the gap, move the picture up
                        the_picture.Top = the_rectangle.Top - the_picture.Height
                        the_picture.Top = the_picture.Top - y_gap_calc
                    End If
               End If
               
            Next
            
        Next
        
    End Sub
    I hope this Powerpoint course which is yours is still available to learn if so then how can I contact with you...thanks...

  6. #6
    Banned VBAX Newbie
    Joined
    Jan 2022
    Posts
    2
    Location
    Quote Originally Posted by ajjava View Post
    See the attached deck. This is what the finished product should look like. Decks can be up to 350 slides.

    The chart/table combos are picture objects that are sometimes placed in random positions on the slide template. Those picture objects need to be aligned with the rectangle shape object on each slide.

    My goal is to automate the alignment of the picture objects with the shape objects. I have code that correctly gets the job done...for about 60% of the slides. Something is going awry for the other 40% and I don't know what it is.

    Any guidance would be hugely appreciated!!

    Here is my objective:

    In the finished deck, each slide will have EITHER 2 or 3 shapes:

    Title 1 + Picture 2

    OR

    Title 1 + Picture 2 + Rectangle 2

    Constants for 3-shape slides:
    • Every slide will have 3 shapes = ‘Title 1’, ‘Picture 2’, ‘Rectangle 2’
    • Rectangle 2 DOESN'T NEED TO BE POSITIONED WITH THIS MACRO and will ALWAYS be in one of two EXACT positions and one of two EXACT sizes = Tall, slim rectangle on right side of slide

    Short, wide rectangle on bottom of slide
    Variables:
    • Picture 2 size can vary, but not by much


    Need a macro that will:

    • For every slide in presentation
    • IF Rectangle 2 is on the RIGHT SIDE of slide, align Picture 2 with MIDDLE of Rectangle 2 WITHOUT REPOSITIONING RECTANGLE 2
      • I already wrote the code for this piece, cleaned up and perfected by John Wilson. See code snippet below

    • IF Rectangle 2 is at the BOTTOM of the slide, align VERTICAL CENTERS of Rectangle 2 and Picture 2 WITHOUT REPOSITIONING RECTANGLE 2
    • In either scenario, need the macro to put a (somewhat) uniform amount of space between Picture 2 and Rectangle 2

    Test Positioning Macro.pptx


    Existing code that takes care of the 1st scenario (where Rectangle 2 is on the right side of the slide):

    Sub Aligner_MIDDLE() 'This aligns one shape's middle to another shape's middle, WITHOUT repositioning the shapes on the slide  John Wilson cleaned up my code
    Dim osl As Slide
    Dim osh As Shape
    Dim osh1 As Shape
    Dim osh2 As Shape
    
    
    Set osl = ActiveWindow.Selection.SlideRange(1)
    
    
    For Each osl In ActivePresentation.Slides
            For Each osh In osl.Shapes
            
            If osh.Name = "Rectangle 2" And osh.Height > 100 Then
            Set osh1 = osh
            End If
            
            If osh.Name = "Picture 2" Then
            Set osh2 = osh
            End If
            
            Next osh
            
            If Not osh1 Is Nothing And Not osh2 Is Nothing Then
            osh2.Top = osh1.Top + osh1.Height / 2 - osh2.Height / 2
            
            
            
            End If
            
    Next osl
    
    
    MsgBox "Macro has finished!" & vbCrLf & "", , "Done!"
    
    
    End Sub
    Nice post, your post is really useful for me. Also Its really nice and epic. Thanks a lot for the quality info on this topic.power point course and halpfull thanks..

  7. #7
    Quote Originally Posted by dustine79 View Post
    I hope this Powerpoint course which is yours is still available to learn if so then how can I contact with you...thanks...
    I have an alternate code. You can DM me for any help. I would love to provide you...Cheers dude...!
    Best Regards,
    kimonlope

  8. #8
    Quote Originally Posted by kimonlope View Post
    I have an alternate code. You can DM me for any help. I would love to provide you...Cheers dude...!
    I am very interested bro, can you share with me...

Posting Permissions

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