TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub NameIt()
    Dim sResponse As String

    With ActiveWindow.Selection.ShapeRange(1)
        sResponse = InputBox("Rename this shape to ...", "Rename Shape", .Name)
        Select Case sResponse
            ' blank names not allowed
            Case Is = ""
                Exit Sub
            ' no change?
            Case Is = .Name
                Exit Sub
            Case Else
                On Error Resume Next
                .Name = sResponse
                If Err.Number <> 0 Then
                    MsgBox "Unable to rename this shape"
                End If
        End Select
    End With

End Sub