Sub Macro1()
Dim orng As Range
    Set orng = Selection.Range
    Do
        orng.Text = orng.Text & "*"
        If orng.Characters.Last.Information(wdVerticalPositionRelativeToPage) > _
           orng.Characters.First.Information(wdVerticalPositionRelativeToPage) Then Exit Do
        DoEvents
    Loop
    orng.Characters.Last.Delete
    orng.Collapse 0
    orng.Select
    Set orng = Nothing
End Sub