Dynamic Excel VBA 更改文本框大小的代码

Question

现在，我正在努力从 Excel 数据中自动化 'PowerPoint Presentation Slides'。根据要求，我必须创建一个可以更新幻灯片 'Title' 的 'dynamic code'，但请记住，如果文本 足够大 那么Box 的 'height' 应该是 double 并且 box 的 'placement' 应该被更改 .

根据我的理解，我尝试了文本的'Length'逻辑，然后相应地更改了框'height'和'placement'。

摘自我的 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

但是这段代码的问题在于，如果我们有这样的字符（在标题文本中）需要更多 space 但是，不会增加长度，例如"M" 或 "W"（字符 "I" 或 "T" 等 vice-versa）。出现更多此类字符会自动移至下一行。

例如

2016 年 ITMS % 销售数字 > 50%
2016 年的 WMSWX % 销售数据 > 50%

理想情况下 1 和 2 都应该在标题的一行中，因为它们的 len < 45 但是因为 W、M、W 和 X 需要更多 space 第二个文本会自动移到下一行但是盒子的高度和位置不是。

所以我的代码不是完全动态或自动化的:(

今后，能否请您提供一个代码，通过该代码可以更适当地更改高度和位置

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

Dynamic Excel VBA 更改文本框大小的代码

Dynamic Excel VBA Code to change the Text box size

excel

powerpoint

vba