Sub Test() Dim s As Shape Dim sr As ShapeRange, sr2 As ShapeRange, sr3 As ShapeRange Set s = ActiveLayer.CreateRectangle(2, 2, 4, 4) s.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0) Set s = ActiveLayer.CreateRectangle2(1, 4, 5, 5) s.Fill.ApplyUniformFill CreateRGBColor(0, 255, 0) Set s = ActiveLayer.CreatePolygon(1, 2, 3, 4, 6) Set sr = ActivePage.FindShapes(, cdrRectangleShape) Set sr2 = ActivePage.FindShapes(, cdrPolygonShape) Set sr3 = ActivePage.FindShapes(, cdrNoShape, True) sr3.RemoveRange srEnd Sub