Size the text in a textbox to fill the textbox
Article contributed by Bill Coan
Sub ResizeTextToFitTextBox()
If Selection.StoryType <> wdTextFrameStory
Then Exit Sub
Dim myTextRange As
Range
Dim myShape As Shape
Set myShape = Selection.ShapeRange(1)
Set myTextRange =
myShape.TextFrame.TextRange
myTextRange.Font.Size = 2
If myShape.TextFrame.Overflowing = True
Then
ActiveDocument.Undo
MsgBox "Even when set to a size of 2 points, the text
overflows the textbox."
Exit Sub
End If
Do Until myShape.TextFrame.Overflowing =
True
myTextRange.Font.Size = _
myTextRange.Font.Size + 0.5
Loop
myTextRange.Font.Size = _
myTextRange.Font.Size - 0.5
End Sub
