Changing the names of text boxes

catflap · #8 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.

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