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

catflap · 05-10-2018, 06:18 AM

Hmmm. I've been playing around with this some more and I now can't beat 31 seconds.

I'm beginning to think I must have made some sort of mistake on the 20 seconds run, but in case it helps anyone, here's the code as it now stands:

Code:

Dim oShp As Shape
    Dim changecount As Integer
    Dim shapecount, shapemax As Long
    Dim Doc As Document
    Dim sbar As Boolean
    Dim timestart, timstop As Date
    Dim changeflag As Boolean
    
    timestart = Now()
    
    shapecount = 1
    shapemax = ActiveDocument.Shapes.Count
    
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True

    changecount = 0
    changeflag = False
    allshapes = ActiveDocument.Shapes.Count
    
    For Each oShp In ActiveDocument.Shapes
        
        With oShp.TextFrame

            If oShp.AlternativeText = "shrink" Then

                    Do While .Overflowing
                        changeflag = True
                        .TextRange.Font.Shrink
                        DoEvents
                    Loop
                    If changeflag = True Then changecount = changecount + 1
                    changeflag = False
                     
           End If
                
        StatusBar = "                                                                                                                                            COMPLETE: " & shapecount & " / " & allshapes
        
        DoEvents
        shapecount = shapecount + 1
        
        End With
        
    Next oShp
       
    Application.ScreenUpdating = True
    
    timestop = Now()

    MsgBox "Complete - " & changecount & " changes made. Time taken: " & DateDiff("s", timestart, timestop) & " seconds"

I added another doevents in the loop - not sure if this helps or not. When I test for time it varies too much anyway to be sure.

Thanks everyone for the input - I've learnt a lot from doing this and it's an improvement on the original.