Dim s As Shape
ActiveDocument.Unit = cdrPoint
For Each s In ActiveSelectionRange
If s.CanHaveOutline Then
With s.Outline
If Round(.Width, 2) < 1 Then
.SetNoOutline
Else
.Width = .Width - 1
End If
End With
End If
Next s
End Sub