[PowerPoint Shape Tweaker] A macro to be ran on selected PowerPoint shapes for easy and consistent tweaks. Change anything including font size, wrap text, position, etc. #PowerPoint
Sub ShapePositioner()
'r converts cm to points
r = 28.3464567
'Shape 1
With ActiveWindow.Selection.ShapeRange
.Left = 1.41 * r 'change the number for desired x position
.Top = 10.23 * r 'change the number for desired y position
End With
'Shape 2
With ActiveWindow.Selection.ShapeRange
.Left = 8.96 * r 'change the number for desired x position
.Top = 10.24 * r 'change the number for desired y position
End With
'Shape 3
With ActiveWindow.Selection.ShapeRange
.Left = 8.96 * r 'change the number for desired x position
.Top = 13.43 * r 'change the number for desired y position
End With
'Shape 4
With ActiveWindow.Selection
.ShapeRange.Left = 17.56 * r
.ShapeRange.Top = 0.9 * r 'change the number for desired y position
.ShapeRange.Height = 1.86 * r
.ShapeRange.Width = 4.05 * r
.TextRange.Font.Size = 7.5
'.TextRange.Name = "Palatino"
'.TextRange.Bold = True
'.TextRange.Color.RGB = RGB(255, 127, 255)
.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignRight
End With
'Shape 5
With ActiveWindow.Selection
.ShapeRange.TextFrame.AutoSize = ppAutoSizeNone
.ShapeRange.Left = 4.01 * r
.ShapeRange.Top = 0.67 * r 'change the number for desired y position
.ShapeRange.Height = 2.77 * r
.ShapeRange.Width = 12.59 * r
.TextRange.Font.Size = 32
'.TextRange.Name = "Palatino"
'.TextRange.Bold = True
'.TextRange.Color.RGB = RGB(255, 127, 255)
.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
End With
End Sub
Sub ShapePositioner()
'r converts cm to points
r = 28.3464567
'Select a shape in PowerPoint
'Edit values below as required
With ActiveWindow.Selection
.ShapeRange.TextFrame.AutoSize = ppAutoSizeNone
.ShapeRange.Left = 4.01 * r
.ShapeRange.Top = 0.67 * r 'change the number for desired y position
.ShapeRange.Height = 2.77 * r
.ShapeRange.Width = 12.59 * r
.TextRange.Font.Size = 32
'.TextRange.Name = "Palatino"
'.TextRange.Bold = True
'.TextRange.Color.RGB = RGB(255, 127, 255)
.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
End With
End Sub
Sub HeadlinePositioner()
'r converts cm to points
r = 28.3464567
'Select a shape in PowerPoint
'Edit values below as required
With ActiveWindow.Selection
.ShapeRange.TextFrame.AutoSize = ppAutoSizeNone
.ShapeRange.Left = 1.99 * r
.ShapeRange.Top = 0.93 * r 'change the number for desired y position
.ShapeRange.Height = 1.87 * r
.ShapeRange.Width = 20.99 * r
.TextRange.Font.Size = 20
.TextRange.Font.Name = "Arial"
'.TextRange.Bold = True
'.TextRange.Color.RGB = RGB(255, 127, 255)
.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
.ShapeRange.TextFrame.VerticalAnchor = msoAnchorMiddle
End With
End Sub
Sub FootnotePositioner()
'r converts cm to points
r = 28.3464567
'Select a shape in PowerPoint
'Edit values below as required
With ActiveWindow.Selection
.ShapeRange.TextFrame.AutoSize = ppAutoSizeNone
.ShapeRange.Left = 12.05 * r
.ShapeRange.Top = 16.67 * r 'change the number for desired y position
.ShapeRange.Height = 2.17 * r
.ShapeRange.Width = 11.83 * r
.TextRange.Font.Size = 8
'.TextRange.Name = "Palatino"
'.TextRange.Bold = True
'.TextRange.Color.RGB = RGB(255, 127, 255)
.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
.ShapeRange.TextFrame.VerticalAnchor = msoAnchorBottom
End With
End Sub