Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 05-10-2018, 06:18 AM
catflap's Avatar
catflap catflap is offline Changing the names of text boxes Windows 7 64bit Changing the names of text boxes Office 2013
Advanced Beginner
Changing the names of text boxes
 
Join Date: Aug 2015
Location: UK
Posts: 72
catflap is on a distinguished road
Default

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.
Reply With Quote
  #17  
Old 05-10-2018, 06:56 AM
Guessed's Avatar
Guessed Guessed is offline Changing the names of text boxes Windows 10 Changing the names of text boxes Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Just tidying the logic a little bit and changing the activewindow view. Is this any different in speed?
Code:
Sub SpeedTest()
  Dim oShp As Shape, changecount As Integer, shapecount As Long, shapemax As Long
  Dim timestart As Date, timestop As Date, changeflag As Boolean
    
  timestart = Now()
  shapemax = ActiveDocument.Shapes.Count
  
  Application.ScreenUpdating = False
  ActiveWindow.View = wdNormalView
  changeflag = False
    
  For Each oShp In ActiveDocument.Shapes
    changeflag = False
    If oShp.AlternativeText = "shrink" Then
      With oShp.TextFrame
        Do While .Overflowing
          changeflag = True
          .TextRange.Font.Shrink
          DoEvents
        Loop
      End With
      If changeflag = True Then changecount = changecount + 1
      StatusBar = String(50, " ") & "Macro status: " & shapecount & " of " & AllShapes
      shapecount = shapecount + 1
    End If
  Next oShp
  
  ActiveWindow.View = wdPrintView
  Application.ScreenUpdating = True
  timestop = Now()
  MsgBox "Complete - " & changecount & " changes made. Time taken: " & DateDiff("s", timestart, timestop) & " seconds"
End Sub
Note that dimensioning without an explicit type gives you a variant. For example,
Dim shapecount, shapemax As Long
gives you shapecount as a variant and shapemax as Long
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #18  
Old 05-10-2018, 09:01 AM
catflap's Avatar
catflap catflap is offline Changing the names of text boxes Windows 7 64bit Changing the names of text boxes Office 2013
Advanced Beginner
Changing the names of text boxes
 
Join Date: Aug 2015
Location: UK
Posts: 72
catflap is on a distinguished road
Default

Hi Guessed

Thanks for posting again - really appreciate your input.

First run your code through seemed a little slower at 48 seconds for the 100 test records, then I ran it again and it came up as 28 seconds!

I guess the process is just massively skewed by environmental factors (ie what else the PC is doing) and I'm going to have to do several more tests and use larger numbers of records and then see what the results are. I've not seen this degree of variance in vba code before, but I guess I'm not usually so concerned with speed.

2 oddities with your code which I can't quite explain:

1. the status bar update text doesn't buff out 50 spaces from the edge, it just sits the code to the left hand side of the screen.

2. The shrink never seems to tackle the first text box it finds - it always skips that but does the rest - weird!

Anyway, I'll do some more tests tomorrow and post my results.
Reply With Quote
  #19  
Old 05-10-2018, 04:23 PM
Guessed's Avatar
Guessed Guessed is offline Changing the names of text boxes Windows 10 Changing the names of text boxes Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

If you are getting variance like that then it is pretty pointless pursuing incremental gains in speed unless you are running this 10+ times a day. However it is always worth learning more efficient ways of coding.

I don't know why the status bar push isn't working (it does work on my machine) but perhaps you could try other characters. eg
StatusBar = String(50, Chr(151)) & "Macro status: " & shapecount & " of " & AllShapes
StatusBar = String(50, Chr(160)) & "Macro status: " & shapecount & " of " & AllShapes
StatusBar = String(50, "_") & "Macro status: " & shapecount & " of " & AllShapes

My guess is that the problem with the first text box being missed is that the alt text is not EXACTLY correct. A space either before or after the visible text would be enough to skip over it. Try this as a modification to avoid that type of issue
If Trim(LCase(oShp.AlternativeText)) = "shrink" Then
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #20  
Old 05-11-2018, 03:03 AM
catflap's Avatar
catflap catflap is offline Changing the names of text boxes Windows 7 64bit Changing the names of text boxes Office 2013
Advanced Beginner
Changing the names of text boxes
 
Join Date: Aug 2015
Location: UK
Posts: 72
catflap is on a distinguished road
Default

Hi

I'll try those.

The alt text thing can't be a naming discrepancy though, as the merge would have created all boxes in the 100 record doc from the same alt text as the original merge doc? - I will check this though.

Last edited by catflap; 05-11-2018 at 06:48 AM.
Reply With Quote
  #21  
Old 05-11-2018, 08:57 AM
catflap's Avatar
catflap catflap is offline Changing the names of text boxes Windows 7 64bit Changing the names of text boxes Office 2013
Advanced Beginner
Changing the names of text boxes
 
Join Date: Aug 2015
Location: UK
Posts: 72
catflap is on a distinguished road
Default

Hi Guessed

Here are the results of running the macro 5 times on a document of 500 pages:

Speedtest macro:

1) 216 seconds
2) 670 seconds
3) 572 seconds
4) 285 seconds
5) 458 seconds

Average: 440 seconds

Previous macro:

1) 799 seconds
2) 498 seconds
3) 629 seconds
4) 525 seconds
5) 500 seconds

Average: 590 seconds

So your latest code is definitely faster, but there's still a huge amount of variation in process time going on.

Interesting what you mentioned about dimensioning as well - I always thought that putting the 2 variants in the same line:

Dim shapecount, shapemax As Long

...would dim both as Long, so I've learned something new there.

By the way, I don't do these jobs every day, but when I do I often have 10 or more docs of 1000 pages each to do, so it's definitely worth me trying to shave as much time off the process as possible.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Changing the names of text boxes 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 names of text boxes Changing the placeholder text for drop down boxes DeadBatteries Word 1 08-24-2012 09:09 AM
Changing the names of text boxes Arrows and text boxes disappear when changing view? Jesse Word 4 06-12-2012 05:28 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:46 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft