Reduce font size automatically

[Todd]

In a title in Powerpoint, if the title gets a little too long, the font size
is reduced automatically. I want to do the same thing in Word. I don't want
the text to wrap or the container to change size, I just want the font to get
smaller. Is there a way, inside of a text box or a table cell or some area to
get Word to perform and automatic font size adjustment?

Thanks in advance,

 

[Jay Freedman]

In a title in Powerpoint, if the title gets a little too long, the
font size is reduced automatically. I want to do the same thing in
Word. I don't want the text to wrap or the container to change size,
I just want the font to get smaller. Is there a way, inside of a text
box or a table cell or some area to get Word to perform and automatic
font size adjustment?

Thanks in advance,

No, there's nothing automatic.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[Cindy M.]

Hi =?Utf-8?B?VG9kZA==?=,

In a title in Powerpoint, if the title gets a little too long, the font size
is reduced automatically. I want to do the same thing in Word. I don't want
the text to wrap or the container to change size, I just want the font to get
smaller. Is there a way, inside of a text box or a table cell or some area to
get Word to perform and automatic font size adjustment?

Word 2002 and later support this in table cells.

Table/Table Properties/Cell/Options/Fit text

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail

 

[Suzanne S. Barnhill]

In a table cell, you can use Table Properties | Cell | Options to choose
"Fit text."

 

[Todd]

Thank you for that help. I tried it and it's a good answer but not completely
satisfying because it weirdly spreads out letters if they don't completely
fill the cells. But it's the best answer for now.

Thanks again

 

[Klaus Linke]

In a title in Powerpoint, if the title gets a little too long, the font
size
is reduced automatically. I want to do the same thing in Word. I don't
want
the text to wrap or the container to change size, I just want the font to
get
smaller. Is there a way, inside of a text box or a table cell or some area
to
get Word to perform and automatic font size adjustment?

Thanks in advance,

Hi Todd,

Not quite a substitute for an automatic font size adjustment, but below's a
macro that should work in regular text, text boxes, and in table cells that
have a specified width.
No guarantees... having written it just now.

Regards,
Klaus


Sub FitPara()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngPara As Range
Set rngPara = Selection.Paragraphs(1).Range
Set rngStart = Selection.Paragraphs(1).Range.Characters.First
Set rngEnd = Selection.Paragraphs(1).Range.Characters.Last
rngEnd.MoveWhile Cset:=Chr(13) & Chr(11) & Chr(7), Count:=wdBackward
rngEnd.Collapse (wdCollapseStart)
If Selection.Paragraphs(1).Range.Font.Size = wdUndefined Then
MsgBox "Paragraph does not have uniform font size", vbExclamation,
"Macro cancelled:"
Exit Sub
End If
If rngEnd.start <= rngStart.start Then
MsgBox "No paragraph to fit was found", vbExclamation, "Macro
cancelled:"
Exit Sub
End If
While rngStart.Information(wdVerticalPositionRelativeToTextBoundary) = _
rngEnd.Information(wdVerticalPositionRelativeToTextBoundary)
rngPara.Font.Size = rngPara.Font.Size * 2
Wend
While rngStart.Information(wdVerticalPositionRelativeToTextBoundary) <> _
rngEnd.Information(wdVerticalPositionRelativeToTextBoundary)
rngPara.Font.Size = rngPara.Font.Size / 1.2
Wend
While rngStart.Information(wdVerticalPositionRelativeToTextBoundary) = _
rngEnd.Information(wdVerticalPositionRelativeToTextBoundary)
rngPara.Font.Size = rngPara.Font.Size * 1.05
Wend
While rngStart.Information(wdVerticalPositionRelativeToTextBoundary) <> _
rngEnd.Information(wdVerticalPositionRelativeToTextBoundary)
rngPara.Font.Size = rngPara.Font.Size / 1.005
Wend
End Sub

 

[Klaus Linke]

I knew I shoould have tested that macro!

1st, font sizes must be multiples of 0.5 pt, so with
multiplication/division, it can run into endless loops.

2nd, because the font size needs to be a multiple of 0.5 pt, the text can't
be fitted perfectly. For the rest, you can use the paragraph alignment
"distributed", which should be hardly noticeable once the font size is as
close as possible to the optimum:

Sub FitPara()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngPara As Range
Set rngPara = Selection.Paragraphs(1).Range
Set rngStart = Selection.Paragraphs(1).Range.Characters.First
Set rngEnd = Selection.Paragraphs(1).Range.Characters.Last
rngEnd.MoveWhile Cset:=Chr(13) & Chr(11) & Chr(7), Count:=wdBackward
rngEnd.Collapse (wdCollapseStart)
rngPara.ParagraphFormat.Alignment = wdAlignParagraphLeft
If Selection.Paragraphs(1).Range.Font.Size = wdUndefined Then
MsgBox "Paragraph does not have uniform font size", _
vbExclamation, "Macro cancelled:"
Exit Sub
End If
If rngEnd.start <= rngStart.start + 1 Then
MsgBox "No paragraph to fit was found", _
vbExclamation, "Macro cancelled:"
Exit Sub
End If
While rngStart.Information(wdVerticalPositionRelativeToTextBoundary) = _
rngEnd.Information(wdVerticalPositionRelativeToTextBoundary)
rngPara.Font.Size = rngPara.Font.Size * 2
Wend
While rngStart.Information(wdVerticalPositionRelativeToTextBoundary) <> _
rngEnd.Information(wdVerticalPositionRelativeToTextBoundary)
rngPara.Font.Size = rngPara.Font.Size - 0.5
Wend
rngPara.ParagraphFormat.Alignment = wdAlignParagraphDistribute
End Sub