Sub Test() Dim s As Shape Dim x As Double, y As Double ActiveDocument.ReferencePoint = cdrBottomLeft For Each s In ActivePage.Shapes s.GetPosition x, y ActiveLayer.CreateRectangle2 x, y, s.SizeWidth, s.SizeHeight Next sEnd Sub