vba - 使文本适合形状
问题描述
我正在使用 PowerPoint VBA 进行编码,并尝试将文本放置在矩形形状内,但要确保文本适合(因此不会溢出)。我不希望形状本身调整大小,而是要调整文本大小。
我已经看到我可以使用
oShp.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
但是,这样做的问题是,当 PowerPoint 处于正常模式时,只有在用户单击文本框后,文本才会调整大小。当 PowerPoint 运行时,我想要这个功能!
我很高兴知道有没有办法让文本自动调整大小,还是我需要找到替代方法?
感谢您的任何评论!
解决方案
我想我会回答我的问题并关闭线程。经过大量研究后,我发现没有明显的方法可以在 PowerPoint Show 运行时让文本自动调整大小。我尝试了多种方法,例如插入文本、修剪文本以及关闭和打开自动换行 - 但是,这些方法都不起作用。我注意到(Bhavesh)我完全知道如何通过 PowerPoint 的 GUI 选择自动大小的文本设置。
最后我的解决方案是做一个循环并改变文本的大小。
下面我粘贴了我的关键行,希望它可以帮助其他试图做同样事情的人。我做了一个变量溢出,试图评估形状文本框的高度是否大于矩形的大小。
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
推荐阅读
- python - 我无法获取selenium python 中的所有标签
- python - 更新与 mongodb 中的查询匹配的多个数组元素
- django - 如果查询结果为空,Django如何显示错误
- python-3.x - Python:如何将字节串转换为字符串?
- java - 如何将 BaseActivity 移植到 AppCompatActivity Android
- java - getter 和 setter 的动态类型转换
- flutter - 无法在轮播中加载图像列表
- java - 如何将布尔属性传递给 WSO2 EI 中的类中介
- flutter - 在颤动剪辑之前向蒙版添加框阴影
- javascript - 是否可以根据屏幕大小在 Chart.JS 中维护两种不同的字体大小?