Sub ResizeTextToFitTextBox()
'Saves you the trouble of manually resizing textboxes to their content.
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