How to insert column in powerpoint using VBA

Question

The questions is bit tricky one, I have googled and got a link http://joelblogs.co.uk/2010/08/13/automatically-create-summary-slides-in-powerpoint-2010/ with VBA code which helps me to insert summary of the titles of all the other slides of one presentation in single parent slide. The code is working fine, however when the number of slides with titles is more than 30 or 50 then the Table of content parent slide cannot hold the entire title names as the names will be hidden and go beyond the slide presentation. Hence, I like to confirm are there any VBA code to distribute the contents of the summary names in to three columns through VBA in the table of contents slide ?

Kazimierz Jawor Kazimierz Jawor · Accepted Answer · 2013-04-05T09:15:17

Based on the link where you have an example you need to add that code at the and of your macro:

With summary.Shapes(2).TextFrame2
    .Column.Number = 3
End With

which set 3 columns in your summary text frame. Remember, that you could need to set font size, too, to keep your text within text box.

Additional information: What I see is that font size changes (decrease) as long as you put more text into summary Shape (Shapes(2) in my example). You could then trace the font size to check if you should increase number of columns. Here is an example:

With summary.Shapes(2).TextFrame2
    If .TextRange.Font.Size < 20 Then
        'additionally check here if max approved column numbers is not exceeded.
        .Column.Number = .Column.Number + 1
    End If
End With

And here is my full basic test code (which could be run for any new empty presentation):

Sub test_loop()
    Dim summary As Slide
    Set summary = ActivePresentation.Slides.Add(1, ppLayoutText)

    Dim enterText as string
Do
    enterText = InputBox("Additional text to insert into Shape:")

With summary.Shapes(2).TextFrame2
    .TextRange.Text = .TextRange.Text & Chr(10) & enterText
    If .TextRange.Font.Size < 20 Then
        .Column.Number = .Column.Number + 1
    End If
End With

Loop While enterText <> ""
End Sub

How to insert column in powerpoint using VBA

1 Answers