Changing the names of text boxes

Charles Kenyon · #1 05-08-2018, 04:55 AM

The text boxes that I use do resize, especially expanding to accommodate more text. They will expand vertically. Could you use a smaller box and allow it to expand automatically when more text is inserted?

catflap · #2 05-08-2018, 06:34 AM

Hi both

Here's the code I use - I'd welcome any thoughts on how to make it go faster. It needs to be run after merging to a new document. I'm afraid it's a little messy:

Code:

Sub StopOverflow()

    Dim oShp As Shape
    Dim changecount As Integer
    Dim shapecount, shapemax, pcount, allpages, pagetemp As Long
    Dim Doc As Document
    Dim sbar As Boolean
    
    shapecount = 1
    shapemax = ActiveDocument.Shapes.Count
    
    Application.ScreenUpdating = False
    sbar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    
    pagetemp = 0
    changecount = 0
    allpages = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
    
    For Each oShp In ActiveDocument.Shapes

        If oShp.Type = msoTextBox Then
        
           
            If ActiveDocument.Shapes(oShp.Name).TextFrame.Overflowing Then
                If ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange Like "*|v*" Then
                ' ignore - this is a barcode
                ElseIf ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange Like "*[a-z][a-z][a-z][a-z][a-z]-[a-z][a-z][a-z][a-z][a-z]-[a-z][a-z][a-z][a-z][a-z]*" Then
                ' ignore - this is a UN
                ElseIf ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange Like "*D# -*" Then
                ' ignore - this is a Delegate Code
                ElseIf ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange Like "*Full Pass*" Then
                ' ignore - this is a Full Pass code
                Else
                    Do While ActiveDocument.Shapes(oShp.Name).TextFrame.Overflowing
                        ActiveDocument.Shapes(oShp.Name).TextFrame.TextRange.Font.Shrink
                    Loop
                    changecount = changecount + 1
                End If
           End If
            
        End If
        
        pcount = oShp.Anchor.Information(wdActiveEndPageNumber)
        
        If pagetemp <> pcount Then
            StatusBar = "                                                                                                                                            COMPLETE: " & pcount & " / " & allpages
            pagetemp = pcount
        End If
        
        DoEvents
        shapecount = shapecount + 1
        
    Next
    
    Application.StatusBar = False
    Application.DisplayStatusBar = sbar
    Application.ScreenUpdating = True

    MsgBox "Complete - " & changecount & " changes made."

End Sub

Where I've put in the remarks to ignore some text content relates to what I was thinking about when I mentioned renaming text boxes - it must take time to evaluate the text content in this way, I thought if I could just indicate the text boxes I was interested in, it would be a bit quicker.

I'm afraid I haven't quite got the hang of updating the screen with progress either - it flicks on and off annoyingly, but you can see it go through the pages. The reason there are so many spaces before the text in the StatusBar=" " line is to push the text into the middle of the screen so it doesn't get overwritten by Word.

catflap · #3 05-08-2018, 06:45 AM

Charles

Just following up your point, I need the text boxes to be fixed in size and have the text shrink to fit rather than the opposite way around.

This is for mailing badges which have a fixed area available to print, but variable length text. For example, if 2 names are:

Josephine Amanda Arkwright
Bob Smith

I need Josephine's whole name to appear, so font size needs to reduce. For Bob, the font can stay as it is (assuming I make it fairly big to start with).

In this way, both names roughly fit the badge without having a lot of white space left over and without truncating the names.

sorry I didn't explain this fully earlier!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Formats in text boxes in Word 2016 changing unexpectedly	PugwashAtNPEU	Word	4	05-04-2017 05:53 AM
Changing Default Fonts for Text Boxes and Tables	LadyBug679	PowerPoint	2	04-01-2016 06:42 AM
Changing the font colour in all text boxes	marqives	Word VBA	1	11-25-2014 06:05 PM
Changing the placeholder text for drop down boxes	DeadBatteries	Word	1	08-24-2012 09:09 AM
Arrows and text boxes disappear when changing view?	Jesse	Word	4	06-12-2012 05:28 PM