27 | 06 | 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
Else
strArray = strArray & "," & shp.Name
End If
End If
End If
Next
'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
Next
Exit Function
errorhandler:
UngroupGroup = False
End Function

 

Login

Sign up now and upload your code to the website.

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