Microsoft Office Forums - View Single Post - [Solved] Changing the names of text boxes

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