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.

回答1:

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

来源：https://stackoverflow.com/questions/40831632/understanding-format-of-tables-in-powerpoint-vba-2010-resize-text-to-cell

标签

powerpoint

powerpoint-vba