Delete Shape Problem

[John]

Can anyone tell me what I'm doing wrong? I got a procedure that drops a red
dot ("TestDot") onto the page to the right of each shape that fits a
particular criteria. I've then written another procedure (see below) to
remove the same dots, based on the masters name (again "TestDot"). The weird
thing is that when I run the procedure it only removes some of the dots. I
end up have to run the procedure several times to get rid of all of them.
Any clues on why it doesn't remove the lot in one go?

Thanks

John


Sub RemoveTestDots()

'Removes all shapes in document named "TestDot"

Dim pag As Visio.Page
Dim shp As Visio.Shape

For Each pag In ActiveDocument.Pages
For Each shp In pag.Shapes
If shp.Master.Name = "TestDot" Then
shp.Delete
End If
Next shp
Next pag

End Sub

 

[Chris Roth [ Visio MVP ]]

Naughty, naughty, NAUGHTY!

Deleting items in a For...Each loop is NAUGHTY! I know, I've tried about 600
times, then I finally learned.

You are essentially ripping the carpet out from underneath yourself. When
you delete the shape, you decrease the size of the collection, so some items
hide at the end of the collection and never get reached.

The way to delete items is to count backwards:

For i = items.count to 1 step -1
set shp = shapes.item(i)
...if shapecriteria then shp.delete
Next i

Also, if you're using Visio 2003, check out visPage.CreateSelection. You can
get all of the shapes on a page as a Visio Selection object with just one
call. It looks something like this:

Dim mst as Visio.Master
Set mst = Visio.ActiveDocument.Masters("Red Dot")

Dim selRedDots as Visio.Selection
Set selRedDots = Visio.ActivePage.CreateSelection( flags, flags, flags,
mst )

Dim i as integer
For i = selRedDots.Count to 1 Step -1
selRedDots.Item(i).Delete
Next i


See the Developer help for the CreateSelection flags stuff. I'm too lazy
right now.

--

Hope this helps,

Chris Roth
Visio MVP

 

[John Marshall, MVP]

The layman's description.

When you walk the collection and delete say the second item, the collection
collapes to fill the gap and the original third item becomes the current
second item. Now if you try to delete the original third item, you will
actually be deleting the original fourth item. So the original third item
remains in the collection, untouched, in the position of the original second
item.

When the collection is walked in the reverse direction, all the shapes
affected are after the deleted shapes. The shapes to be processed are
unaffected.
John... Visio MVP

Need stencils or ideas? http://www.mvps.org/visio/3rdparty.htm
Need VBA examples? http://www.mvps.org/visio/VBA.htm
Common Visio Questions http://www.mvps.org/visio/common_questions.htm

 

[John]

Ah I can see the problem. I've had a go with the backwards counting and it
works perfectly!

I'll also have a go with the CreateSelection method later as I can think of
lots of instances where that will be useful already.

Anyway, thanks very much to both you and John. I won't make the same
mistake again - sorry Teach!

Best regards

John

PS - For the benefit of anyone else who's interested, here's the "fixed"
code:

Private Sub RemoveTestDots()

'Removes all shapes in document named "TestDot"

Dim pag As Visio.Page
Dim shp As Visio.Shape

For Each pag In ActiveDocument.Pages
For i = pag.Shapes.Count To 1 Step -1
Set shp = pag.Shapes.Item(i)
If Not (shp.Master Is Nothing) Then
If shp.Master.Name = "TestDot" Then
shp.Delete
End If
End If
Next i
Next pag
End Sub