If i select 2 or more shapes & then run a micro.Rename all shapes name to user input name. code is that but it is not workingSub RenameShape() Dim objName Dim sr As ShapeRangeDim s3 As Shape Set sr = ActiveSelectionRange If sr.Shapes.Count = 0Then MsgBox "You need to select a shape first" Exit Sub End If objName = ActiveWindow.Selection.ShapeRange(1).Name objName = InputBox$("Assing a new name to this shape", "Rename Shape", objName) If objName <> ""Then Set s3 = ActiveDocument.Selection.Name = objName End If Exit Sub End Sub
You need to loop each shape in your shape range: