Sub Authors()
'Format all surnames (found according to their specific signs) in the whole doc
'(all story ranges).

Dim myStoryRng As range
Dim rng As range

    Application.ScreenUpdating = False
    For Each myStoryRng In ActiveDocument.StoryRanges
        Set rng = myStoryRng
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .text = "[Vv]gl. @<[A-Z][!A-Z][a-z]@>"
            .Forward = True
            .MatchWildcards = True
            .Wrap = wdFindStop
            While .Execute
                rng.MoveStartUntil cset:=" "
                rng.Font.Italic = True
                rng.Font.AllCaps = True
                rng.Collapse wdCollapseEnd
            Wend
        End With
    Next myStoryRng
    Application.ScreenUpdating = True
    Set rng = Nothing
 End Sub