vbapowerpoint

Understanding format of tables in PowerPoint (VBA 2010) (resize text to cell)


Following issue:

I declare tbl as Table in VBA. I want to show some tables in PowerPoint.

If the text of the cells are too long, the cells get big and they go beyond the slide limits. I want to avoid that. I just want to resize the text, that means, I just want that the text gets smaller, in order to fit within the cell. That means, cell-table size should not be changed!

How would you do that? I've tried:

ppPres.Slides(NumSlide).Shapes(NumShape).Table.Columns(col).Cells(1).Shape.TextFrame2.AutoSize = msoAutoSizeTextToFitShape

without success. Could you please tell me what's wrong and how would you proceed?

The error message is as follows:

Run-Time error '2147024809 (80070057)'

The specified value is out of range.


Solution

  • This is one of the oddities of the PowerPoint OM. The Shape object has all of the properties listed by IntelliSense, including the AutoSize property, yet when referenced within a table, some properties are not available. AutoSize is one of them. For example, if you place your cursor within a cell and open the the Format Shape pane in PowerPoint, you can see that the 3 AutoSize radio buttons are greyed out as well as the Wrap text in shape checkbox: enter image description here In the above example, which was created by adding the table via the PowerPoint UI rather than programmatically, I then copied the text from cell 2,1 to 1,2 with this code and the cell didn't change width but does change height, potentially forcing the table off of the bottom of a slide:

    ActiveWindow.Selection.ShapeRange(1).Table.Cell(1,2).Shape.TextFrame.TextRange.Text=_
    ActiveWindow.Selection.ShapeRange(1).Table.Cell(2,1).Shape.TextFrame.TextRange.Text
    

    If it's this that you're trying to control, you'll need to do it manually in code via examining the table cell and/or table height after inserting your text and reducing the font size iteratively and rechecking each reduction level to see if the table is still out of the slide area.

    This code does that for you:

    Option Explicit
    
    ' =======================================================================
    ' PowerPoint Subroutine to iteratively reduce the font size of text
    ' in a table until the table does not flow off the bottom of the slide.
    ' Written By : Jamie Garroch of YOUpresent Ltd. http://youpresent.co.uk/
    ' Date : 05DEC2016
    ' Inputs : Table object e.g. ActiveWindow.Selection.ShapeRange(1).Table
    ' Outputs : None
    ' Dependencies : None
    ' =======================================================================
    Sub FitTextToTable(oTable As Table)
      Dim lRow As Long, lCol As Long
      Dim sFontSize As Single
      Const MinFontSize = 8
      With oTable
        Do While .Parent.Top + .Parent.Height > ActivePresentation.PageSetup.SlideHeight
          For lRow = 1 To .Rows.Count
            For lCol = 1 To .Columns.Count
              With .Cell(lRow, lCol).Shape
                sFontSize = .TextFrame.TextRange.Font.Size
                If sFontSize > MinFontSize Then
                  .TextFrame.TextRange.Font.Size = sFontSize - 1
                Else
                  MsgBox "Table font size limit of " & sFontSize & " reached", vbCritical + vbOKOnly, "Minimum Font Size"
                  Exit Sub
                End If
              End With
              ' Resize the table (effectively like dragging the bottom edge and allowing PowerPoint to set the table size to the text.
              .Parent.Height = 0
            Next
          Next
        Loop
      End With
    End Sub