了解PowerPoint中的表格式（VBA 2010）（将文本大小调整为单元格）

Question

以下问题：

我将tbl声明为VBA中的表。我想在PowerPoint中显示一些表格。

如果单元格的文本太长，则单元格变大，超出滑动限制。我想避免这种情况。我只是想调整文本的大小，这意味着，我只是希望文本变小，以便适合单元格。这意味着，不应更改单元格表大小！

你会怎么做？我试过了：

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

没有成功。你能告诉我什么是错的，你会怎么做？

错误消息如下：

  

运行时错误'2147024809（80070057）'

     

指定的值超出范围。

Answer 1

这是PowerPoint OM的一个奇怪之处。 Shape对象具有IntelliSense列出的所有属性，包括 AutoSize 属性，但在表中引用时，某些属性不可用。 AutoSize就是其中之一。例如，如果将光标放在单元格中并打开PowerPoint中的格式形状窗格，则可以看到3个AutoSize单选按钮显示为灰色，以及换行文本形状复选框： 在上面的示例中，这是通过PowerPoint UI而不是以编程方式添加表而创建的，然后我使用此代码将文本从单元格2,1复制到1,2，并且单元格没有更改宽度，但确实更改了高度，可能会迫使桌子离开幻灯片的底部：

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

如果它是您试图控制的，那么您需要在插入文本并减少字体后检查表格单元格和/或表格高度，在代码中手动执行此操作迭代地调整大小并重新检查每个缩小级别以查看表格是否仍然在滑动区域之外。

此代码适用于您：

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