Sub Test() Dim s As Shape Dim n As Long n = 1 For Each s In ActivePage.Shapes If s.Type = cdrPolygonShape Then s.Name = "Polygon " & n: n = n + 1 Next s End Sub