How can I speed this up

[Phil Stanton]

Can anyone help me please

The bit of code below outputs 30 text boxes onto a page and takes about 25
seconds to do.
This is a trial sample of something I am trying to develop.
My 2 Questions are
1) Is there a limit to the number of text boxes you can output to a
document, and
2) If not, how can I speed this up. The application I am working on
potentially has thousands of text boxes to output over 10s of pages.

Many thanks
Phil

Option Explicit



Function DrawTextBoxs(NoBoxes As Integer)



Dim i As Long

Dim TopCorner As Long

Dim LeftCorner As Long



For i = 1 To NoBoxes



If LeftCorner = 0 Then

LeftCorner = 20

Else

LeftCorner = LeftCorner + 150

End If

If TopCorner = 0 Then

TopCorner = 10

End If

If LeftCorner > 500 Then

LeftCorner = 20

TopCorner = TopCorner + 100

End If



ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal,
LeftCorner, TopCorner, 100, 80).Select



Selection.ShapeRange.Select

With Selection.ShapeRange

.TextFrame.MarginLeft = 0#

.TextFrame.MarginRight = 0#

.TextFrame.MarginTop = 0#

.TextFrame.MarginBottom = 0#

.Fill.Visible = msoTrue

.Fill.Solid

.Fill.ForeColor = i * 3000

.Fill.Transparency = 0#

.Line.Transparency = 0#

.Line.Visible = msoTrue

If i / 2 = i \ 2 Then

.Line.DashStyle = msoLineSolid

.Line.Style = msoLineSingle

.Line.Weight = 5

Else

.Line.DashStyle = msoLineSquareDot

.Line.Style = msoLineSingle

.Line.Weight = 2

End If

.Line.Style = msoLineSingle

.Line.ForeColor = 1500000 - (i * 2000)

End With



With Selection.Font

If i / 2 = i \ 2 Then

.NameAscii = "Arial"

Else

.NameAscii = "Comic Sans"

End If

.Size = 10 + i \ 2

.Bold = True

.Italic = False

.Underline = True

.UnderlineColor = wdColorAutomatic

.StrikeThrough = False

.DoubleStrikeThrough = False

.Outline = False

.Emboss = False

.Shadow = False

.Hidden = False

.SmallCaps = False

.AllCaps = False

.Color = 2000 + (i * 3500)

.Engrave = False

.Superscript = False

.Subscript = False

.Spacing = 0

.Scaling = 100

.Position = 0

.Kerning = 0

.Animation = wdAnimationNone

End With

' Center

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Selection.TypeText Text:="This is Text Box " & i

Selection.Collapse

Next i



End Function

Sub Test()

'

' Test Macro

' Macro created 07/12/2004

'

Call DrawTextBoxs(30)



End Sub

 

[Jean-Guy Marcil]

Phil Stanton was telling us:
Phil Stanton nous racontait que :

Can anyone help me please

The bit of code below outputs 30 text boxes onto a page and takes
about 25 seconds to do.
This is a trial sample of something I am trying to develop.
My 2 Questions are
1) Is there a limit to the number of text boxes you can output to a
document, and
2) If not, how can I speed this up. The application I am working on
potentially has thousands of text boxes to output over 10s of pages.

Why not use a table?
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Phil Stanton]

Thanks Jean

Unfortunately the text box size, format, contents, colour, borders, font,
and position ,etc, etc are all pretty random. This information is being
passed to Word from another application.

The sample output is a little misleading as it all looks much the same size.

Phil

 

[Jay Freedman]

Hi Phil,

The actual time is going to depend a lot on what hardware you can
throw at the job. On this PC (an Athlon 2800+ with a gig of memory),
using Word 2003 on Windows XP Pro, your macro runs in 2.5 seconds,
plus or minus a couple of tenths. The relative ratios in the figures
below should be pretty constant, though.

First I tried assigning the result of the AddTextbox command to a
Shape object and using only that object's properties to format the
textboxes, making maximum use of With...End With statements, and
completely eliminating use of the Selection. Instead of speeding up
the macro as I expected, it actually nearly tripled the time, to about
7 seconds. Evidently VBA's internal methods for accessing Shape object
properties are very inefficient.

Then I went to the old standby, turning off screen updating at the
start of the macro and turning it back on at the end. The DrawTextBoxs
routine is untouched. That cut the time by more than half, to only 0.9
second!

Here's the code I used, including the timing statements:

Sub Test()
'
' Test Macro
' Macro created 07/12/2004
'
Dim StartTime As Single
StartTime = Timer
Application.ScreenUpdating = False
Call DrawTextBoxs(30)
Application.ScreenUpdating = True
MsgBox "Time taken was: " & (Timer - StartTime) & " seconds"
End Sub

 

[Phil Stanton]

Thanks Jay.

That certainly has improved things considerably.

My test down from about 25 seconds to 5.25 seconds - a considerable
improvement.

Thanks again