Sub Test() Dim s As Shape Dim spath As SubPath Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double ActiveDocument.ReferencePoint = cdrBottomLeft For Each s In ActiveSelection.Shapes If s.Type <> cdrCurveShape Then s.ConvertToCurves If s.Type = cdrCurveShape Then For Each spath In s.curve.Subpaths x1 = spath.PositionX y1 = spath.PositionY x2 = x1 + spath.SizeWidth y2 = y1 + spath.SizeHeight ActiveLayer.CreateRectangle x1, y1, x2, y2 Next spath End If Next s End Sub