-
This is the code I tried to solve this problem. But, not sure how to polish this so that it works perfectly. Could anyone please suggest modifications so that my code works fine. I used overlap function to check boundary conditions form the source :
https://stackoverflow.com/questions/...owerpoint-2007 - shape overlap function
Sub Grouping()
Dim V AsLong
Dim oSh1 As Shape
Dim oSh2 As Shape
Dim Shapesarray()As Shape
OnErrorResumeNext
If ActiveWindow.Selection.ShapeRange.Count <2Then
MsgBox "Select at least 2 shapes"
ExitSub
EndIf
ReDim Shapesarray(1To ActiveWindow.Selection.ShapeRange.Count)' maximum
array size = no.of shapes selected, dynamic array
For V =1To ActiveWindow.Selection.ShapeRange.Count
' A condition to check boundary conditions and add shape into array if it is true.
Set oSh1 = ActiveWindow.Selection.ShapeRange(V)
Set oSh2 = ActiveWindow.Selection.ShapeRange(V +1)
If ShapesOverlap(oSh1, oSh2)=TrueThen
' boundary conditions AND shape type is not a connector
' the next shape it is going to add should be atleast nearby the present
shape,if so add into array or group current array anderase contents in
that array
Set Shapesarray(V)= oSh1
Set Shapesarray(V +1)= oSh2
'else move to next shape in selction range and check
EndIf
' group items in array
Range(Shapesarray).Group ' Grouping all the elements of the array
V = V +1
Next V
' at last remaining shapes in shape collection are grouped all together
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules