Autosize Text in a Shape - one line

Hi All -

These shape properties shrink the text to fit and allow it to wrap.

.TextFrame2.WordWrap = msoTrue
.TextFrame2.AutoSize = msoAutoSizeTextToFitShape

If I set wordwrap = msoFalse, the Autosize does not work.

I'm trying to get the text to shrink to fit in the shape (rectangle) without wrapping. i.e. just one line to display without wrapping regardless of how small the text becomes.

Does anyone have any thoughts on how to achieve a single line, no wrap autosize?

Shrink text on overflow only works if the text does not fit the shape VERTICALLY

There is no built in setting that reduces text size when it overflows horizontally

It is possible to write an AddIn that would do this but you would need to know how to write a withEvents Class module.

To run code manually try

Code:

---

Sub chex()    Dim oshp As Shape
    Dim safety As Long
    On Error Resume Next
    Set oshp = ActiveWindow.Selection.ShapeRange(1)
    Dim otr2 As TextRange2
    If oshp.HasTextFrame Then
        Set otr2 = oshp.TextFrame2.TextRange
        If otr2.BoundWidth > oshp.Width Then
            Do
            ' note just in case you create an endless loop
            safety = safety + 1
                otr2.Font.Size = otr2.Font.Size - 1
            Loop Until otr2.BoundWidth < oshp.Width Or safety = 25
        End If
    End If
End Sub

---