Hi
After a mail merge to a new document, I need to make sure all the text in a text box fits without overflowing. This I can achieve with the following code which loops though all the text boxes, checks if they overflow, and if so keeps reducing the font by one point until they fit:
Code:
Dim oShp As Shape
For Each oShp In ActiveDocument.Shapes
If oShp.Type = msoTextBox Then
Do While ActiveDocument.Shapes(oShp.Name).TextFrame.Overflowing
ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange.Font.Size = ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange.Font.Size - 1
Loop
End If
Next
Things come unstuck however when the text box has more than one font size.
Does anyone know how I could loop though the lines in the text box (so I could resize them one at a time)? - there's only ever one font size per line, so this would work.
Or is there a better way maybe?