Adding columns into a Text Box in PowerPoint with VBA?

[Exposian]

Hi all,

I have a question regarding columns in text box in PowerPoint.

I am trying to add columns into the code below but I am not sure where to add it? Can anyone kindly advise me? It would be much appreciated!

Regards,
Philippe

Trying to add this:


.Column.Spacing = 15
.Column.Number = 2


To this:


Sub PlainText()
Dim o As Shape
On Error GoTo Catch
Set o = ActiveWindow.Selection.ShapeRange(1)
If Not o Is Nothing Then
With o
.Left = 31.125
.Top = 134.5
.Height = 60
.Width = 381.375
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
With .TextFrame
.WordWrap = msoTrue
.AutoSize = ppAutoSizeShapeToFitText
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.MarginBottom = 0
.VerticalAnchor = msoAnchorTop
.HorizontalAnchor = msoAnchorNone
With .TextRange
If .Text = "" Then
.Text = "<Put your text here>"
.Select
End If
.ParagraphFormat.SpaceWithin = 1.1
.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
With .Font
.Name = CG_DEFAULT_FONT
.Size = 10
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
End With
End With
End With
End With
End If
Exit Sub
Catch:
If Err.Number = -2147188160 Then MsgBox CG_NOTHING_SELECTED
End Sub

[John Wilson]

From 2007 you should use TextFrame2 NOT TextFrame. This will give access to the new commands. You cannot use underline with TextFrame2. Either delete it or use .UnderlineStyle = msoNoUnderline also Emboss these are only applicable to legacy 2003 code


Sub PlainText()
'added
Const CG_DEFAULT_FONT As String = "Arial"

Dim o As Shape
On Error GoTo Catch
Set o = ActiveWindow.Selection.ShapeRange(1)
If Not o Is Nothing Then
With o
.Left = 31.125
.Top = 134.5
.Height = 60
.Width = 381.375
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
'NOTE TextFrame2
With .TextFrame2
.WordWrap = msoTrue
.AutoSize = ppAutoSizeShapeToFitText
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.MarginBottom = 0
.VerticalAnchor = msoAnchorTop
.Column.Number = 2
.Column.Spacing = 15
With .TextRange
If .Length = 0 Then
.Text = "<Put your text here>"
.Select
End If
.ParagraphFormat.SpaceWithin = 1.1
.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
With .Font
.Name = CG_DEFAULT_FONT
.Size = 10
.Fill.ForeColor.RGB = vbBlack
.Bold = msoFalse
.Italic = msoFalse
.UnderlineStyle = msoNoUnderline
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
End With
End With
End With
End With
End If
Exit Sub
Catch:
If Err.Number = -2147188160 Then MsgBox "Error"
End Sub

[Exposian]

John, you are the YODA of VBA!

This works like a charm! Thanking you again for some amazing solutions. You're the best.

Regards,
Philippe