了解 PowerPoint 中表格的格式 (VBA 2010)(将文本调整为单元格)
Understanding format of tables in PowerPoint (VBA 2010) (resize text to cell)
以下问题:
我在 VBA 中将 tbl 声明为 Table。我想在 PowerPoint 中显示一些 table。
如果单元格的文本太长,单元格会变大并超出幻灯片限制。我想避免这种情况。我只想调整文本的大小,也就是说,我只想让文本变小,以适应单元格。这意味着,cell-table 大小不应更改!
你会怎么做?我试过:
ppPres.Slides(NumSlide).Shapes(NumShape).Table.Columns(col).Cells(1).Shape.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
没有成功。你能告诉我哪里出了问题吗?你将如何进行?
报错信息如下:
Run-Time error '2147024809 (80070057)'
The specified value is out of range.
这是 PowerPoint OM 的怪异之处之一。 Shape 对象具有 IntelliSense 列出的所有属性,包括 AutoSize 属性,但在 table 中引用时,某些属性不可用。 AutoSize 就是其中之一。例如,如果您将光标放在一个单元格内并在 PowerPoint 中打开 Format Shape 窗格,您会看到 3 个 AutoSize 单选按钮以及 将文本环绕成形状 复选框:
在上面的示例中,它是通过 PowerPoint UI 添加 table 而不是以编程方式创建的,然后我使用此代码将文本从单元格 2,1 复制到 1,2 并且单元格没有' t 改变宽度但改变高度,可能迫使 table 离开幻灯片底部:
ActiveWindow.Selection.ShapeRange(1).Table.Cell(1,2).Shape.TextFrame.TextRange.Text=_
ActiveWindow.Selection.ShapeRange(1).Table.Cell(2,1).Shape.TextFrame.TextRange.Text
如果您要控制的是这个,则需要在插入文本后通过检查 table 单元格 and/or table 高度在代码中手动完成并反复减小字体大小并重新检查每个减小级别以查看 table 是否仍在幻灯片区域之外。
此代码为您完成:
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
以下问题:
我在 VBA 中将 tbl 声明为 Table。我想在 PowerPoint 中显示一些 table。
如果单元格的文本太长,单元格会变大并超出幻灯片限制。我想避免这种情况。我只想调整文本的大小,也就是说,我只想让文本变小,以适应单元格。这意味着,cell-table 大小不应更改!
你会怎么做?我试过:
ppPres.Slides(NumSlide).Shapes(NumShape).Table.Columns(col).Cells(1).Shape.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
没有成功。你能告诉我哪里出了问题吗?你将如何进行?
报错信息如下:
Run-Time error '2147024809 (80070057)'
The specified value is out of range.
这是 PowerPoint OM 的怪异之处之一。 Shape 对象具有 IntelliSense 列出的所有属性,包括 AutoSize 属性,但在 table 中引用时,某些属性不可用。 AutoSize 就是其中之一。例如,如果您将光标放在一个单元格内并在 PowerPoint 中打开 Format Shape 窗格,您会看到 3 个 AutoSize 单选按钮以及 将文本环绕成形状 复选框:
ActiveWindow.Selection.ShapeRange(1).Table.Cell(1,2).Shape.TextFrame.TextRange.Text=_
ActiveWindow.Selection.ShapeRange(1).Table.Cell(2,1).Shape.TextFrame.TextRange.Text
如果您要控制的是这个,则需要在插入文本后通过检查 table 单元格 and/or table 高度在代码中手动完成并反复减小字体大小并重新检查每个减小级别以查看 table 是否仍在幻灯片区域之外。
此代码为您完成:
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