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.
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.