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

[ajjava]

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

25282


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

[ajjava]

If I say "pretty please with a cherry on top"?

[venablest]

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

[ajjava]

This is perfect. I can't thank you enough :hi:

[dustine79]

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.. (https://gbapps.net/).


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...

[thomas121]

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

25282


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.. (https://gbplusmod.com/)

[kimonlope]

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...!

[Andrew125]

I have an alternate code. You can DM me for any help. I would love to provide you.. (https://clashmod.net/nulls-brawl-download/).Cheers dude...!

I am very interested bro, can you share with me...