Sub Test() Dim s As Shape For Each s In ActivePage.Shapes If s.Outline.Width > 0.1 Then s.Outline.Style = OutlineStyles(1) End If Next sEnd SubSub Test() With ActiveShape.Outline .Width = 0.03 .Style.DashCount = 2 .Style.DashLength(1) = 1 .Style.DashLength(2) = 10 .Style.GapLength(1) = 4 .Style.GapLength(2) = 4 End WithEnd Sub