martinctc
3/28/2017 - 1:39 PM

PowerPoint Shape Tweaker A VBA macro to be ran on selected PowerPoint shapes for easy and consistent tweaks. Change anything including font

[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

ppt_tweakshape.vbs
content_copyfile_download
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
PowerPoint Tweak Shapes.vbs
content_copyfile_download
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
Headline Positioner.vbs
content_copyfile_download
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
FootnotePositioner.vbs
content_copyfile_download
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