Changing the names of text boxes

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

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