hello,
i got this nice lines of code, which works very fine for me to group all shapes in my active worksheet.
how can i alter the code to ungroup the shapes if i want to it by code instead of do it by hand?
Sub group_all()
Dim varArr() As Variant
Dim shp As Shape
Dim intAnzahl As Integer
For Each shp In ActiveSheet.Shapes
intAnzahl = intAnzahl + 1
ReDim Preserve varArr(1 To intAnzahl)
varArr(intAnzahl) = shp.Name
Next
Set shp = ActiveSheet.Shapes.Range(varArr).Group
shp.Name = "All"
End Sub
Thanks in advance,
stefan
Ungroup All Shapes in Active Worksheet
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
-
- Administrator
- Posts: 78678
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Ungroup All Shapes in Active Worksheet
In this particular situation, you end up with a single shape named "All" on the active sheet, so the following is sufficient to ungroup:
A more general macro allows for multiple grouped shapes on the sheet:
If you have grouped shapes that contain grouped shapes among its members, it becomes more complicated.
Code: Select all
Sub UngroupAll()
ActiveSheet.Shapes("All").Ungroup
End Sub
Code: Select all
Sub UngroupAll()
Dim i As Long
On Error Resume Next
For i = ActiveSheet.Shapes.Count To 1 Step -1
ActiveSheet.Shapes(i).Ungroup
Next i
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: Ungroup All Shapes in Active Worksheet
hi Hans,
thank You for your quick post; both solutions work fine for me. As an additional but not necessary question: is it so possible to group or ungroup even all shapes of one type - like freform, or a connector?
Stefan
thank You for your quick post; both solutions work fine for me. As an additional but not necessary question: is it so possible to group or ungroup even all shapes of one type - like freform, or a connector?
Stefan
-
- Administrator
- Posts: 78678
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Ungroup All Shapes in Active Worksheet
To group shapes of a specific type:
Call like this to group freeforms:
Ungrouping is more tricky - a grouped shape has type msoGroup, reagardless of the composition of the group. So you'd have to inspect the shapes within the group:
Call like this to ungroup groups consisting entirely of freeforms:
Code: Select all
Sub GroupSpecific(ShapeType As MsoShapeType)
Dim varArr() As Variant
Dim shp As Shape
Dim intAnzahl As Integer
For Each shp In ActiveSheet.Shapes
If shp.Type = ShapeType Then
intAnzahl = intAnzahl + 1
ReDim Preserve varArr(1 To intAnzahl)
varArr(intAnzahl) = shp.Name
End If
Next shp
Set shp = ActiveSheet.Shapes.Range(varArr).Group
shp.Name = "AllFreeforms"
End Sub
Code: Select all
Sub GroupFreeforms()
Call GroupSpecific(msoFreeform)
End Sub
Code: Select all
Sub UngroupSpecific(ShapeType As MsoShapeType)
Dim i As Long
Dim shp As Shape
Dim f As Boolean
On Error Resume Next
For i = ActiveSheet.Shapes.Count To 1 Step -1
f = True
With ActiveSheet.Shapes(i)
If .Type = msoGroup Then
For Each shp In .GroupItems
If Not shp.Type = ShapeType Then
f = False
Exit For
End If
Next shp
If f Then
.Ungroup
End If
End If
End With
Next i
End Sub
Code: Select all
Sub UngroupFreeforms()
Call UngroupSpecific(msoFreeform)
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: Ungroup All Shapes in Active Worksheet
cool, thank you!
so i can easy adopt the code to group rectangles and so on.... ;-))
so i can easy adopt the code to group rectangles and so on.... ;-))
-
- Administrator
- Posts: 78678
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Ungroup All Shapes in Active Worksheet
Here's a slightly improved version of the first macro; it lets you specify the name of the grouped shape.
To group shapes of a specific type:
Call like this to group freeforms:
BTW, for rectangles, you must look at the AutoShapeType property instead of at the Type property, for the Type for rectangles is msoAutoShape. The AutoShapeType is msoShapeRectangle.
To group shapes of a specific type:
Code: Select all
Sub GroupSpecific(ShapeType As MsoShapeType, GroupName As String)
Dim varArr() As Variant
Dim shp As Shape
Dim intAnzahl As Integer
For Each shp In ActiveSheet.Shapes
If shp.Type = ShapeType Then
intAnzahl = intAnzahl + 1
ReDim Preserve varArr(1 To intAnzahl)
varArr(intAnzahl) = shp.Name
End If
Next shp
Set shp = ActiveSheet.Shapes.Range(varArr).Group
shp.Name = GroupName
End Sub
Code: Select all
Sub GroupFreeforms()
Call GroupSpecific(msoFreeform, "AllFreeforms")
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 415
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: Ungroup All Shapes in Active Worksheet
hi Hans,
thanks for Your second reply and improvement as well. I will try to adopt it today and test it.
stefan
thanks for Your second reply and improvement as well. I will try to adopt it today and test it.
stefan