VBA and shapes very slow

macropod · #16 02-15-2016, 08:03 PM

Likewise.

A workaround that might be useful given the apparent speed improvement with new documents, would be to create a new document, generate the shapes there, then replicate them (e.g. via FormattedText) in the target document:

Code:

Sub MesureDureebis()
Dim i As Long, Boite As Shape, Debut As Date, DocTmp As Document, Rng As Range
Debut = Time
Application.ScreenUpdating = False
Set Rng = Selection.Range
Set DocTmp = Documents.Add
With DocTmp
  For i = 1 To 500
    Set Boite = .Shapes.AddShape(msoShapeRectangle, 4 * i, 72.75, 4, 19.5)
    Boite.Fill.ForeColor.RGB = RGB(2 * i, 2 * i, 2 * i)
  Next i
  Rng.FormattedText = .Range.FormattedText
  .Close False
End With
Application.ScreenUpdating = True
MsgBox CStr((Time - Debut) * 24 * 3600) & " s"
End Sub

macropod · #17 02-15-2016, 08:07 PM

Quote:

Originally Posted by gmaxey

This is a strange issue that I am certainly unable to explain.

Likewise.

However, given that the code works much better with a new document, perhaps the following could serve as the basis for a workaround:

Code:

Sub MesureDureebis()
Application.ScreenUpdating = False
Dim i As Long, Boite As Shape, Debut As Date, DocTmp As Document, Rng As Range
Debut = Time
Set Rng = Selection.Range
Set DocTmp = Documents.Add
With DocTmp
  For i = 1 To 500
    Set Boite = .Shapes.AddShape(msoShapeRectangle, 4 * i, 72.75, 4, 19.5)
    Boite.Fill.ForeColor.RGB = RGB(2 * i, 2 * i, 2 * i)
  Next i
  Rng.FormattedText = .Range.FormattedText
  .Close False
End With
Application.ScreenUpdating = True
MsgBox CStr((Time - Debut) * 24 * 3600) & " s"
End Sub

jpl · #18 02-16-2016, 05:39 AM

Hello

Here are the results I obtain for diverse versions of the macro:

Original macro (post # 1), modified to draw 500 rectangles: 108 seconds.
Macro modified by macropod (post # 17): 90 seconds
Macro (post # 5): 3 seconds.

I modified the macro of the message 17 in the following way:

Code:

...
    With DocTmp
      .Windows(1).Visible = False
      For i = 1 To 500
    ...

The macro runs in 5 seconds.

With Word 2003, the original macro runs in 1 second. Moreover, the original macro, adapted for Excel, runs in 0 seconds with Excel 2010!

There is apparently a problem of Shape objects handling in word 2010. It is surprising that nobody speaks about it on the Internet.

Thank you for your help.

Bonjour
Voici les résultats que j'obtiens pour diverses versions de la macro :
macro originale (message 1), modifiée pour dessiner 500 rectangles : 108 secondes
macro modifiée par macropod (message 17) : 90 secondes
macro (message 5) : 3 secondes.
J'ai modifié la macro du message 17 de la façon suivante :

La macro s'exécute en 5 secondes.
Avec Word 2003, la macro originale prend 1 seconde. Par ailleurs, la macro originale, adaptée pour Excel, s'exécute en 0 seconde avec Excel 2010 !
Il y a visiblement un problème de maniement des objets Shape en Word 2010. Il est surprenant que personne n'en parle sur Internet.
Merci pour votre aide

macropod · #19 02-16-2016, 05:47 AM

Did you try it without '.Windows(1).Visible = False'? For me it ran in about 1 second.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
shapes in header	mhagi	Word VBA	2	10-16-2015 12:21 AM
Slow internet = Slow Word...	User12344321	Word	4	09-21-2015 12:54 PM
All Shapes on slide	excelledsoftware	PowerPoint	9	09-15-2013 04:03 AM
Where did map shapes go?	SueK	PowerPoint	1	01-20-2011 04:30 AM
My Shapes some appear some don't	Jean-Paul	Visio	0	03-01-2006 01:38 AM