Klaus,

If I can make a suggestions to dress the code up a bit. As is, if the
user selects the final paragraph mark a continous loop occurs. I added
the following lines to prevent this:

Dim i As Integer
i = Selection.StoryType
Set myRange = Selection.Range.Duplicate
If myRange.End = ActiveDocument.StoryRanges(i).End Then
myRange.MoveEnd wdCharacter, -1
End If