26 | 02 | 2017

Group Specific Shapes

This tutorial can group using specific filters. It will group only shapes where the names start with 'SHAPE'. Shapes that aren't visible will not be added to the group.

Sub GroupItems()

'**** Code from VisibleVisual.com ****
On Error Resume Next

UngroupGroup "GROUPSHAPE"
Dim shpRange As ShapeRange
Dim strArray As String
strArray = ""
For Each shp In ActiveSheet.Shapes

If shp.Name Like "SHAPE*" Then
'This function only groups shapes that start with the name SHAPE... Change shape to 8 to group all shapes
If shp.Visible = True Then 'If a shape is not visible then it will not be grouped
'Now create a stringarray
If strArray = "" Then
strArray = shp.Name
strArray = strArray & "," & shp.Name
End If
End If
End If
'The stringarray with all shapes is completed and needs to be converted to a reall array
'The same method can be used to select multiple shapes
Dim x As Variant
Dim sha As Shape

x = Split(strArray, ",")
Set sha = ActiveSheet.Shapes.Range((x)).Group

sha.Name = "GROUPSHAPE"
sha.Select 'All visible shapes where the name starts with SHAPE have been grouped

End Sub

Sub UnGroupItems()
UngroupGroup "GROUPSHAPE"
End Sub

Function UngroupGroup(ByVal ShapeGroupName As String) As Boolean
On Error GoTo errorhandler
Dim shpRange As ShapeRange
Dim sh As Shape

For Each sh In ActiveSheet.Shapes
If sh.Name = ShapeGroupName Then sh.Ungroup: UngroupGroup = True: Exit Function
Exit Function
UngroupGroup = False
End Function



Sign up now and upload your code to the website.

Help us to continue.....
Articles View Hits
Latest Articles