使文本适合形状

Question

我正在使用 PowerPoint VBA 进行编码，并尝试将文本放置在矩形形状内，但要确保文本适合（因此不会溢出）。 我不希望形状本身调整大小，而是要调整文本大小。

我已经看到我可以使用

oShp.TextFrame2.AutoSize = msoAutoSizeTextToFitShape

但是，这样做的问题是，当 PowerPoint 处于正常模式时，只有在用户单击文本框后，文本才会调整大小。 当 PowerPoint 运行时，我想要这个功能！

我很高兴知道有没有办法让文本自动调整大小，还是我需要找到替代方法？

感谢您的任何评论！

Answer 1

我想我会回答我的问题并关闭线程。 经过大量研究后，我发现没有明显的方法可以在 PowerPoint Show 运行时让文本自动调整大小。 我尝试了多种方法，例如插入文本、修剪文本以及关闭和打开自动换行 - 但是，这些方法都不起作用。 我注意到（Bhavesh）我完全知道如何通过 PowerPoint 的 GUI 对 select 进行自动大小文本设置。

最后我的解决方案是做一个循环并改变文本的大小。

下面我粘贴了我的关键行，希望它可以帮助其他试图做同样事情的人。 我做了一个变量溢出，试图评估形状文本框的高度是否大于矩形的大小。

Dim overflow As Integer
Dim counter As Integer    

counter = 0

With ActivePresentation.Slides(i).Shapes(stringToTest)
                    
overflow = CInt((.TextFrame.TextRange.BoundHeight) - (.Height - .TextFrame.MarginTop - .TextFrame.MarginBottom))
                    
Do While overflow > 16 And counter < 50
'*** I note that the shape is overflowing when its value is >0 but I found 16 to be the most "aesthetically pleasing" number!
'*** Also using a counter prevents the code from potentially getting stuck in an infinite loop

If .TextFrame.TextRange.Font.Size > 20 Then                                
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 1
Else
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 0.5
End If
'**** By reducing the font size by 0.5 this provided a better fit for the text _
'**** (even better than using on PowerPoint's auto-size function!)

counter = counter + 1
overflow = CInt((.TextFrame.TextRange.BoundHeight) - (.Height - .TextFrame.MarginTop - .TextFrame.MarginBottom))
Loop

End With

Answer 2

在形状格式中，在文本选项下，选择溢出时缩小文本的选项。

然后，使用.Shapes("Title 1").TextFrame.TextRange TextFrame.TextRange 我们通过 VBA 输入文本。

文本会自动更改其字体大小。