动态Excel VBA代码更改文本框大小

Question

现在，我正在从Excel数据中自动化"PowerPoint演示文稿幻灯片"。根据要求，我必须创建一个"动态代码"，它可以更新幻灯片的"标题"，但要记住，如果文本足够大，则框的"高度"应为的两倍并且框的"位置"应更改。

根据我的理解，我尝试了文本的"长度"逻辑，然后相应地更改框的"高度"one_answers"位置"。

我的excel vba代码摘录

Dim powApp As PowerPoint.Application
Dim powPres As PowerPoint.Presentation
Dim powSlide As PowerPoint.Slide
Set powApp = New PowerPoint.Application
Set powSlide = powPres.Slides(2)
Set powShape = powSlide.Shapes(3)
'cell W7 contains the length of the text of the Title
If Sheets("sht1").Range("W7").Value > 45 Then
With powShape
.Top = 13
.Height = 57.5
End With
ElseIf Sheets("sht1").Range("W7").Value <= 45 Then
With powShape
.Top = 20
.Height = 32
End With
End If

但这个代码的问题是，如果我们有这样的字符(在标题文本中)，它会占用更多的空间，但不会增加长度，例如"M"或"W"(反之亦然，字符"I"或"t"等)。出现更多这样的字符会自动转移到下一行。

例如

1. 2016年ITMS%销售额超过50%
2. WMSWX 2016年销售额超过50%

理想情况下，1和2都应该在标题的一行中，因为它们都有len<45，但由于W、M、W和X占用了更多空间，第二个文本会自动移动到下一行，但框的高度和位置不会。

因此，我的代码不是完全动态的或自动化的：(

从今以后，你能建议一个代码吗？通过这个代码，高度和位置可以更合适地改变

Answer 1

有一种方法可以测量文本框的宽度，这与测量文本字符串的宽度不同。我过去所做的是创建一个临时文本框，用所需字体的文本填充它，并测量它的宽度。下面是一些示例代码，您可以使用这些代码来满足自己的需求。

根据文本框(包括文本)的宽度，您可以在代码中调整框的大小。

Option Explicit
Sub test()
Dim width As Long
width = MeasureTextFrame("Here Is My Test Title Which Might be Really Long", isBold:=True)
Debug.Print "text box width is " & width
width = MeasureTextFrame("Here Is Another Title That's Shorter", isBold:=True)
Debug.Print "text box width is " & width
End Sub
Public Function MeasureTextFrame(ByVal inputText As String, _
Optional ByVal thisFont As String = "Arial", _
Optional ByVal thisSize As Long = 14, _
Optional ByVal isBold As Boolean = False) As Double
Dim thisPPTX As Presentation
Set thisPPTX = ActivePresentation
'--- create a temporary slide for our measurements
Dim thisSlide As Slide
Dim thisLayout As CustomLayout
Set thisLayout = thisPPTX.Slides(1).CustomLayout
Set thisSlide = thisPPTX.Slides.AddSlide(thisPPTX.Slides.Count + 1, thisLayout)
Dim thisFrame As TextFrame
Set thisFrame = thisSlide.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100).TextFrame
With thisFrame
.WordWrap = msoFalse
.AutoSize = ppAutoSizeShapeToFitText
.TextRange.Text = inputText
.TextRange.Font.Name = thisFont
.TextRange.Font.Size = thisSize
.TextRange.Font.Bold = isBold
End With
'--- return width is in points
MeasureTextFrame = thisFrame.Parent.width
'--- now delete the temporary slide and frame
thisSlide.Delete
End Function