Aligning text/ text box in a shape using VBA in PowerPoint

[CuriosityBug]

Hello,

I have been hustling to move text/ text box/ text frame present in a shape to the center, so that it looks uniform and good. As shown in the attached picture, I would like to center "climate" in lower rectangle shape.

I know by default a text box is center aligned. But If I am working with a shape that doesn't have text box, a text box is inserted on shape, during this process the text is aligned differently. If this repeats throughout the presentation, it is a time consuming task.

Any insights or suggestions is like ray of light. Thank you.

[John Wilson]

Not sure I understand what you need but you can set the default textbox style

Insert a text box
Right Click > Format Shape
In the TextBox menu

Set Vertical Alignment to Middle Centered
Choose Do Not AutoFit
All margins to zero (probably)

Then right click and "Set as Default Text Box"

[CuriosityBug]

Not sure I understand what you need but you can set the default textbox style

Insert a text box
Right Click > Format Shape
In the TextBox menu

Set Vertical Alignment to Middle Centered
Choose Do Not AutoFit
All margins to zero (probably)

Then right click and "Set as Default Text Box"

Hello John,

I want to create a macro that can reposition the text box or text if it is not in desired position. In the picture, the text " climate" is disoriented. A macro that can automatically detect this disorientation and move/align text to the center of shape it is present(in this case it is moving the 'climate' text to center of rectangular shape)

This can be done manually.But I am trying to automate the task since they are many instances in different slides through out the presentations.

[John Wilson]

You would need to select two shapes (Only one of which can hold text.)


Sub aligner()
'only works for 2 shapes
' only one shape can hold text
Dim oshp1 As Shape
Dim oshp2 As Shape
If ActiveWindow.Selection.ShapeRange.Count <> 2 Then
MsgBox "Select exactly two shapes", vbCritical
Exit Sub
End If
If ActiveWindow.Selection.ShapeRange(1).HasTextFrame Then
Set oshp1 = ActiveWindow.Selection.ShapeRange(1)
Set oshp2 = ActiveWindow.Selection.ShapeRange(2)
Else
Set oshp2 = ActiveWindow.Selection.ShapeRange(1)
Set oshp1 = ActiveWindow.Selection.ShapeRange(2)
End If
With oshp1
.TextFrame2.AutoSize = msoAutoSizeNone
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.Left = oshp2.Left
.Top = oshp2.Top
.Width = oshp2.Width
.Height = oshp2.Height
End With
End Sub