Fit Mail Merge Text to a certain Width

[Jeff Deville]

I'm creating some labels with content that will vary in width
drastically enough that I currently have to run 3 batches, altering the
font size for each run so that the content fits on the label. Is there
a way to dynamically set the font size to fit? I know there are some
VBA properties that allow you to fit selection text to a certain width
(CentimetersToPoints, InchesToPoints), but I need to execute this code
for each record that is merged. I've found the
"MailMergeAfterRecordMerge" event, but don't quite see how to employ it
yet.

Thoughts? Thanks

 

[Jeff Deville]

Ok, well I sort of answered my own question. If I iterate through the
fields in the mail merge document, I can run the InchesToPoints()
method on each one.
MailMerge.Fields(index).Select
Selection.FitTextWidth = InchesToPoints(##)

Unfortunately, I'm not terribly thrilled with these results. The font
size isn't altered, it's just stretched/compressed to varying degrees,
which looks awful.

I have figured out how to iterate through the paragraphs, and I could
use this to alter the font sizes, but in order to do this through a
guess/check method, I need a way to determine how wide my selection is.
Is there a way to do this?

 

[Jeff Deville]

Ok, well I'll just post this as a solution for anyone who may be
interested. Here are the steps I am taking:

1. Set up your mail merge as usual
2. Use styles as a way of determining what text you need to resize.
For instance, I have a field called 'Name' that is what I am worried
will require resizing. So I created a style and used it exclusively
for this field.
3. Merge to a new document
4. In this new document, add this code to the VBA editor:

Public Sub PrintParagraphsToFormat()
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
If para.Style = "<<INSERT THE STYLE NAME YOU CHOSE HERE>>" Then
para.Range.Select
While (IsTooLong(para))
Selection.Font.Size = Selection.Font.Size - 1
Wend
End If
Next
End Sub

Public Function IsTooLong(para As Paragraph) As Boolean
Dim rng As Range
Set rng = para.Range
Dim iHeightFront As Integer
Dim iHeightEnd As Integer
iHeightFront = rng.Information(wdVerticalPositionRelativeToPage)
rng.Collapse (WdCollapseDirection.wdCollapseEnd)
rng.MoveEnd Unit:=wdCharacter, Count:=-1
iHeightEnd = rng.Information(wdVerticalPositionRelativeToPage)
IsTooLong = iHeightFront <> iHeightEnd
End Function

What this code does is iterate through each paragraph in the document,
and check the style that is applied to that paragraph. If it matches
the one in question, then it checks the vertical position before and
after the paragraph. If these two values are not the same, then the
text must be wrapping to another line. So it lowers the font one size
at a time until the text fits on one line.

This is not a generic, pretty solution, but hopefully will help someone
get started.