Sub Test() Dim s As Shape ActiveDocument.ReferencePoint = cdrCenter For Each s In ActiveLayer.Shapes s.CreateSelection s.Stretch 2 Next sEnd Sub