Sub Index() Dim s As Shape For Each s In ActiveDocument.Selection.Shapes If s.Outline.Type = cdrOutline Then With s.Outline If .StartArrow.Index = 1 Then .StartArrow = ArrowHeads(5) End If If s.Outline.EndArrow.Index = 1 Then s.Outline.EndArrow = ArrowHeads(5) End If End With End If Next sEnd Sub