Challenge: Fit text to text box in Word

Hi everyone.

I need to fit a random number of lines of text vertically within a Word text
box. The height of the text box, the font, and the font size will remain the same,
but the number of lines will change.

Right now the user pastes the data and then manually fits the data to
the text box (so it fills it from top to bottom equally spaced) by adjusting the paragraph line spacing.
It is a rather tedious process manually, but I thought it might be able to be automated.

The text box height is 7.53 and the font is Arial 9.

Any ideas?

Absolutely. Anything tedious should be automated.
The simplest approach I could think of was to simply try different values for line spacing, until you find one that is too large (text won't fit any more). Then set the line spacing to just below that.

Brief example:
Sub main()

Const c_DesiredHeight = 80
Const c_Step = 5

Dim tb As Shape
Set tb = ActiveDocument.Shapes(1)

tb.TextFrame.AutoSize = True

With tb.TextFrame.TextRange.ParagraphFormat
.LineSpacingRule = wdLineSpaceExactly
Dim i As Long 'each 1 step in i equals 1/10th of a point
For i = 90 To 170 Step c_Step
.LineSpacing = i / 10
Application.ScreenRefresh 'force Word to redraw the textbox
If tb.Height > c_DesiredHeight Then
'we've gone one step too far - reverse that, and stop
.LineSpacing = (i - c_Step) / 10
Exit For
End If
Next i
End With

tb.TextFrame.AutoSize = False
tb.Height = c_DesiredHeight

End SubChanging the Step value will change the precision - smaller steps will lead to more precise adjustments, but slower code. Everything else should be self-explanatory.

Absolutely. Anything tedious should be automated.
The simplest approach I could think of was to simply try different values for line spacing, until you find one that is too large (text won't fit any more). Then set the line spacing to just below that.

Brief example:
Sub main()

Const c_DesiredHeight = 80
Const c_Step = 5

Dim tb As Shape
Set tb = ActiveDocument.Shapes(1)

tb.TextFrame.AutoSize = True

With tb.TextFrame.TextRange.ParagraphFormat
.LineSpacingRule = wdLineSpaceExactly
Dim i As Long 'each 1 step in i equals 1/10th of a point
For i = 90 To 170 Step c_Step
.LineSpacing = i / 10
Application.ScreenRefresh 'force Word to redraw the textbox
If tb.Height > c_DesiredHeight Then
'we've gone one step too far - reverse that, and stop
.LineSpacing = (i - c_Step) / 10
Exit For
End If
Next i
End With

tb.TextFrame.AutoSize = False
tb.Height = c_DesiredHeight

End SubChanging the Step value will change the precision - smaller steps will lead to more precise adjustments, but slower code. Everything else should be self-explanatory.



Thanks for the code herilane. Unfortunately, it seems to resize the
text box to the text, rather than spacing the text to the text box.

I'll keep digging. :)

Really? That's not what it did when I tried it.

It sets the textbox autosize to true. It then tries different line spacings, letting the textbox autosize accordingly. It then compares this autosized height to the height you want, and if theyr'e the same, turns off autosize again. The text should now fit nicely in the box.

Really? That's not what it did when I tried it.

It sets the textbox autosize to true. It then tries different line spacings, letting the textbox autosize accordingly. It then compares this autosized height to the height you want, and if theyr'e the same, turns off autosize again. The text should now fit nicely in the box.


My mistake. There is a lot going on in this particular document.
Not only was the code running against a different text box, but someone
has added some incomplete code to the Normal.dot (for some reason)
that seems to interfere with your code.

I'm going to clean things up and try it again.

Thanks again.