Resizing fonts in a text box

catflap · #1 03-23-2018, 04:42 AM

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?

catflap · #2 03-23-2018, 05:36 AM

UPDATE:

Think I've got a way around this. Instead of re-sizing I just use this:

Code:

ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange.Font.Shrink

... and it seems to work without having to loop around doing one point size at a time and it can handle multiple font sizes.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Changing Default Fonts for Text Boxes and Tables	LadyBug679	PowerPoint	2	04-01-2016 06:42 AM
TrueColor BMP “fonts” in word w/ replace text>bmp script (trouble)	Sinsearach	Word VBA	3	03-02-2016 04:16 AM
How to print a line of text with all available fonts in the same document	electrocad	Word VBA	1	10-17-2015 04:53 AM
Fast switching between text fonts	Kyouran	Word	2	11-27-2012 12:54 AM
Fonts error when I used 2 types of fonts in 1 file	cmengenie	Word	3	03-18-2012 02:49 PM