Sub Test() Dim sr As ShapeRange Dim s As Shape Set sr = ActiveDocument.SelectionRange For Each s In sr If s.Type = cdrTextShape Then s.RemoveFromSelection Next s End Sub