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.
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: 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