Adding a Large Number of Shapes is Very Slow in Word 2002

[vDiVito]

I have a fairly simple macro that adds 186 WordArt shapes to a Word document.
When the macro starts it executes fairly quickly for the first few rows of
shapes and then starts to get progressively slower as it goes. It seems if
there are more than just a few shapes on the doc things get really slow.
Execution takes minutes. Any suggestions are appreciated. My code is here:


Option Explicit

Sub Test()

Dim s As String
Dim a As Integer
Dim i As Integer
Dim vpos As Long
Dim hpos As Long
Dim oShape As Shape


Application.ScreenUpdating = False

vpos = 104

For a = 1 To 31

hpos = 53

s = a

'Place line number
Set oShape = ActiveDocument.Shapes.AddTextEffect _
(PresetTextEffect:=msoTextEffect6, _
Text:=s, _
FontName:="Comic Sans MS", _
FontSize:=10, _
FontBold:=False, _
FontItalic:=False, _
Left:=0#, _
Top:=0#)

With oShape
.RelativeHorizontalPosition =
wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.ScaleHeight 0.7, msoFalse, msoScaleFromBottomRight
.TextEffect.ToggleVerticalText
.Fill.ForeColor = vbRed
.Line.BackColor.RGB = RGB(0, 0, 0)
.Shadow.ForeColor.RGB = RGB(0, 0, 0)
.Line.Visible = msoFalse
.IncrementRotation 0
.WrapFormat.Type = wdWrapNone
.ZOrder msoBringToFront
.Left = hpos - .Width
.Top = vpos
End With
Set oShape = Nothing


'Place 5 three digit numbers
hpos = 85

For i = 1 To 5

s = "333"

Set oShape = ActiveDocument.Shapes.AddTextEffect _
(PresetTextEffect:=msoTextEffect6, _
Text:=s, _
FontName:="Comic Sans MS", _
FontSize:=12, _
FontBold:=True, _
FontItalic:=False, _
Left:=0#, _
Top:=0#)


With oShape

.RelativeHorizontalPosition =
wdRelativeHorizontalPositionPage
.RelativeVerticalPosition =
wdRelativeVerticalPositionPage
.ScaleWidth 1.4, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.6, msoFalse, msoScaleFromBottomRight
.TextEffect.ToggleVerticalText
.Fill.ForeColor = vbRed
.Line.BackColor.RGB = RGB(0, 0, 0)
.Shadow.ForeColor.RGB = RGB(0, 0, 0)
.Line.Visible = msoFalse
.IncrementRotation 0
.WrapFormat.Type = wdWrapNone
.ZOrder msoBringToFront
.Left = hpos
.Top = vpos

End With

Set oShape = Nothing

hpos = hpos + 61
Next i

vpos = vpos + 13.5
Next a

Application.ScreenUpdating = True


End Sub

 

[DaveLett]

Hi,
Have a look at the article "Getting help with calling Word's built-in
dialogs using VBA (and why doing so can be much more useful than you'd think)
" at http://word.mvps.org/FAQs/MacrosVBA/WordDlgHelp.htm

As much as you possibly can, you will want to use a dialog box to set all of
the properties for your With oShape blocks. You will also want to remove some
of the lines that are done by default anyway. For example, you could remove
..ZOrder msoBringToFront because when Word adds a new shape object it's in
front anyway. You can also remove
..Line.BackColor.RGB = RGB(0, 0, 0)
..Shadow.ForeColor.RGB = RGB(0, 0, 0)
because .Line.Visible = msoFalse would hide any formatting for that line.
There are one or two other things you can remove, but this should get you
started. Here's a brief example of the material that you should put into a
separate function, which you would call after you add a .Select to your With
oShape block:

With Dialogs(wdDialogFormatDrawingObject)
.PositionVertRel = wdRelativeVerticalPositionPage
.PositionHorzRel = wdRelativeHorizontalPositionPage
.Left = PointsToInches(lLeft)
.Top = PointsToInches(lTop)
.Wrap = wdWrapNone
.Execute
End With

So, in context, this is the second formatting block that you have that
starts with With oShape:

With oShape
.ScaleWidth 1.4, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.6, msoFalse, msoScaleFromBottomRight
.TextEffect.ToggleVerticalText
.Fill.ForeColor = vbRed
.Line.Visible = msoFalse
.Select
Call fFormatWordArt(lLeft:=hpos, lTop:=vpos)
End With

This should get you started. If I knew the other dialog boxes and their
arguments that would replace the remaining, then I would offer it up.
However, I don't and cannot seem to find them.

Good luck,
Dave

 

[Jay Freedman]

An additional comment: I don't know whether you've simplified the macro to
post the question, or whether it's the actual macro you plan to use. If it's
the real macro, then there's absolutely no point in creating and formatting
each of the "333" shapes separately. Create it and format it once; then
either cut it to the clipboard and paste it repeatedly, or store it as an
AutoText entry and insert it repeately. Then you need only to position the
copies.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

 

[vDiVito]

Thanks for your response. I appreciate the pointers on speeding up the main
block of code but my real problem is that the code gets slower as more shapes
are added to the document. I inserted a timer into my code and you can see
here the execution time of each main loop which places 6 shapes. The second
set of times is the macro executed with 186 shapes already present on the
document.

Loop 1 time: 0.578125 seconds
Loop 2 time: 0.65625 seconds
Loop 3 time: 1.046875 seconds
Loop 4 time: 1.375 seconds
Loop 5 time: 1.90625 seconds
Loop 6 time: 2.125 seconds
Loop 7 time: 2.390625 seconds
Loop 8 time: 2.75 seconds
Loop 9 time: 3.09375 seconds
Loop 10 time: 3.546875 seconds
Loop 11 time: 3.953125 seconds
Loop 12 time: 4.484375 seconds
Loop 13 time: 5.03125 seconds
Loop 14 time: 5.546875 seconds
Loop 15 time: 6.109375 seconds
Loop 16 time: 6.65625 seconds
Loop 17 time: 7.203125 seconds
Loop 18 time: 7.703125 seconds
Loop 19 time: 8.21875 seconds
Loop 20 time: 8.8125 seconds
Loop 21 time: 9.34375 seconds
Loop 22 time: 9.921875 seconds
Loop 23 time: 10.5625 seconds
Loop 24 time: 11.21875 seconds
Loop 25 time: 11.78125 seconds
Loop 26 time: 12.42188 seconds
Loop 27 time: 12.95313 seconds
Loop 28 time: 13.57813 seconds
Loop 29 time: 14.28125 seconds
Loop 30 time: 15.73438 seconds
Loop 31 time: 15.48438 seconds


With 186 shapes already present:

Loop 1 time: 16.42188 seconds
Loop 2 time: 18.5 seconds
Loop 3 time: 19.85938 seconds
Loop 4 time: 16.98438 seconds
Loop 5 time: 18.15625 seconds
Loop 6 time: 19.34375 seconds
Loop 7 time: 18.42188 seconds
Loop 8 time: 19.57813 seconds
Loop 9 time: 19.17188 seconds
Loop 10 time: 20.76563 seconds
Loop 11 time: 20.23438 seconds
Loop 12 time: 20.48438 seconds
Loop 13 time: 22.25 seconds
Loop 14 time: 23.67188 seconds
Loop 15 time: 23.75 seconds
Loop 16 time: 23.32813 seconds
Loop 17 time: 29.64063 seconds
Loop 18 time: 26.20313 seconds
Loop 19 time: 26.3125 seconds
Loop 20 time: 25.64063 seconds
Loop 21 time: 25.65625 seconds
Loop 22 time: 26.0625 seconds
Loop 23 time: 27.79688 seconds
Loop 24 time: 29.71875 seconds
Loop 25 time: 30.0625 seconds
Loop 26 time: 30.95313 seconds
Loop 27 time: 32.46875 seconds
Loop 28 time: 31.73438 seconds
Loop 29 time: 31.5625 seconds
Loop 30 time: 30.96875 seconds
Loop 31 time: 34.76563 seconds

 

[macropod]

Hi Dave,

The OP has posted the same topic at:
http://www.vbaexpress.com/forum/showthread.php?t=28243
and
http://www.tek-tips.com/viewthread.cfm?qid=1566959&page=1
plus who knows how many other places, all with nary a mention of the other threads.

 

[vDiVito]

Sorry about that but I am new to posting. Those other two threads are the
only other places.

Hi Dave,

The OP has posted the same topic at:
http://www.vbaexpress.com/forum/showthread.php?t=28243
and
http://www.tek-tips.com/viewthread.cfm?qid=1566959&page=1
plus who knows how many other places, all with nary a mention of the other threads.

--
Cheers
macropod
[Microsoft MVP - Word]

Hi,
Have a look at the article "Getting help with calling Word's built-in
dialogs using VBA (and why doing so can be much more useful than you'd think)
" at http://word.mvps.org/FAQs/MacrosVBA/WordDlgHelp.htm

As much as you possibly can, you will want to use a dialog box to set all of
the properties for your With oShape blocks. You will also want to remove some
of the lines that are done by default anyway. For example, you could remove
.ZOrder msoBringToFront because when Word adds a new shape object it's in
front anyway. You can also remove
.Line.BackColor.RGB = RGB(0, 0, 0)
.Shadow.ForeColor.RGB = RGB(0, 0, 0)
because .Line.Visible = msoFalse would hide any formatting for that line.
There are one or two other things you can remove, but this should get you
started. Here's a brief example of the material that you should put into a
separate function, which you would call after you add a .Select to your With
oShape block:

With Dialogs(wdDialogFormatDrawingObject)
.PositionVertRel = wdRelativeVerticalPositionPage
.PositionHorzRel = wdRelativeHorizontalPositionPage
.Left = PointsToInches(lLeft)
.Top = PointsToInches(lTop)
.Wrap = wdWrapNone
.Execute
End With

So, in context, this is the second formatting block that you have that
starts with With oShape:

With oShape
.ScaleWidth 1.4, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.6, msoFalse, msoScaleFromBottomRight
.TextEffect.ToggleVerticalText
.Fill.ForeColor = vbRed
.Line.Visible = msoFalse
.Select
Call fFormatWordArt(lLeft:=hpos, lTop:=vpos)
End With

This should get you started. If I knew the other dialog boxes and their
arguments that would replace the remaining, then I would offer it up.
However, I don't and cannot seem to find them.

Good luck,
Dave

 

[vDiVito]

Yes, the code was simplified for posting here. The text string that is used

 

[vDiVito]

Dave,

Thanks for the pointers. I have tried all you have suggested and it is still
extremely slow and dependent on the number of shapes in the doc.

BTW - I thought Select was to be avoided as it is supposedly slower than With?

 

[Jay Freedman]

It still might be worth experimenting with making one shape, pasting and
positioning all the copies, and then changing the text of each one. All the
other formatting would need to be done only once.

 

[Manfred F]

Hi vDiVito,

I've made the experience (W2003) that doing a large number of changes in
large documents can be accelerated by saving the document inbetween several
times.

Regards,

Manfred