Question

现在，我正在根据Excel数据自动执行“ PowerPoint演示幻灯片”。根据要求，我必须创建一个“动态代码”，该代码可以更新幻灯片的“标题”，但要记住，如果文本足够大，则文本的“高度”框应为 double ，框的位置应为应更改。

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

我的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”等）。这些字符中的更多字符会自动移至下一行。

例如

ITMS在2016年的销售额百分比已超过50％
WMSWX在2016年的销售额百分比> 50％

理想情况下1和2都应位于Title的一行中，因为它们的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

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

1 个答案: