Dynamic Excel VBA Code to change the Text box size

Question

Right now, I am working to automate the 'PowerPoint Presentation Slides' from Excel data. As per the requirement, I have to create a 'dynamic code' which can update the 'Title' of the slide however, keeping in mind that if the text is large enough then the 'height' of the Box should be double and 'placement' of the box should be changed .

As per my understanding, I tried a logic of 'Length' of the text and then change the box 'height' and 'placement' accordingly.

Excerpts from my excel vba code

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

But the problem with this code is that if we have such characters (in title text) which takes more space however, doesn't increases the length eg "M" or "W" (and vice-versa for the Character "I" or "T" etc). Presence of more of these characters shifts to the next line automatically.

Eg

1. ITMS % in Year 2016 Sales figures has > 50%
2. WMSWX % in Year 2016 Sales figures has > 50%

Ideally 1 and 2 both should be in the one line of Title as they both have len < 45 but since W, M, W and X takes more space 2nd text is automatically shifting to next line but the box height and placement not.

So my code is not completely dynamic or automated:(

Henceforth, can you please suggest a code through which height and placement are changed more appropriately

Answer 1

There is a way to measure the width of a text frame -- which is not the same thing as measuring the width of a text string. What I've done in the past is to create a temporary text frame, populate it with the text in the desired font, and measure the width of that. Here's some example code you can use to fit your needs.

Based on the width of the text frame, including your text, you can adjust the size of the frame in your code.

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