Autosize Text in a Shape - one line

[sprivitor]

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?

[John Wilson]

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


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