Deleting shapes crashes for me. (Excel 97 vba)

E

Excel Question

This is code I've written quickly to find all the shapes on a sheet
that are groups, replace them with pictures and delete the groups.

Sub replace_groups()

Dim sh As Shape
Dim dShTop, dShLeft, dShHeight, dShWidth As Double
Dim lCounter, lLastShape As Long

For Each sh In ActiveSheet.Shapes
If sh.Type = msoGroup Then
With sh
dShTop = .Top
dShLeft = .Left
dShHeight = .Height
dShWidth = .Width

.Copy
End With

ActiveSheet.PasteSpecial Format:="Picture (Enhanced
Metafile)", _
Link:=False, DisplayAsIcon:=False
lLastShape = ActiveSheet.Shapes.Count

With ActiveSheet.Shapes(lLastShape)
.Top = dShTop
.Left = dShLeft
.Height = dShHeight
.Width = dShWidth
End With

End If ' shape is a group
Next sh

For lCounter = lLastShape To 1 Step -1
If ActiveSheet.Shapes(lCounter).Type = msoGroup Then
ActiveSheet.Shapes(lCounter).Select
' ActiveSheet.Shapes(lCounter).Delete
If MsgBox("Delete shape " & lCounter & "?", 292, "Deleting
shapes") _
= 6 Then ActiveSheet.Shapes(lCounter).Delete
End If
Next lCounter

End Sub


If I leave in the stupid messagebox, the program runs without
crashing. If I try to delete directly it crashes.

I would really appreciate
A: A better way to replace all of the shapes on a worksheet that are
of type msogroup with shapes of time msopicture
and/or
B: An explanation of why the code above crashes excel unless I stop
and interact with the user every time before deleting a shape.

Thanks in advance.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top