Here's a few ideas... Sub rotateAndDuplicate() 'select shape and run macro Dim s As Shape, s1 As Shape, i&, r&, iMax&, strName$ Dim sr2 As New ShapeRange iMax = 5 'times to perform action strName = "myShape" 'name of your shape without number at the end Set s = ActiveShape s.Name = strName & 1 sr2.Add s 'add it to sr2 If s Is Nothing Then Exit Sub For i = 2 To iMax Set s1 = s.Duplicate r = r + 360 / iMax s1.Rotate r s1.Name = strName & i sr2.Add s1 'add it to sr2 Next i 'welds in this same sub ActiveDocument.ClearSelection sr2.CreateSelection ActiveSelection.Weld ActiveSelection, False End Sub Sub selectAndWeld() 'use another sub to weld Dim sr As ShapeRange, s As Shape Dim strName$, i& strName = "myShape" ActiveDocument.ClearSelection Set sr = ActivePage.Shapes.FindShapes For Each s In sr i = InStr(1, s.Name, strName, 1) 'separated lines so you can more clearly see InStr work If i > 0 Then s.Selected = True i = 0 'flag back to zero Next s If ActiveSelection.Shapes.Count > 1 Then ActiveSelection.Weld ActiveSelection, False End Sub
↧