Выборочное подчеркивание

Sub UnderlineEvery10()
  Dim i As Long
  For i = 10 To ActiveDocument.Words.Count Step 10
    ActiveDocument.Words(i).Font.Underline = wdUnderlineSingle
  Next i
End Sub

Sub UnderlineEvery10()
  Dim i As Long, n As Byte
  Do
'   Отсчёт девяти пробельных промежутков. Курсор становится в начале десятого слова.
'   Индекс i служит для отслеживания конца документа.
    For n = 1 To 9
'     Смещение курсора до первого пробела, считая от положения курсора.
      i = Selection.MoveUntil(" ", 100)
'      Смещаем курсор к началу слова, следующего за этим пробелом.
'      При этом пропуская символы, которые могу быть перед словом _
      (открывающие кавычки, скобки и т.п.)
      i = Selection.MoveWhile(" (""«„", 100)
    Next
'    Выделение слова, стоящего сразу за курсором, отсекая символы, _
    которые могут быть в конце слова (знаки препинания и т.п.)
    Selection.MoveEndUntil " .,:;?!""»“)", 100
'    Подчёркивание выделенного слова
    Selection.Font.Underline = wdUnderlineSingle
'    Переход к следующему слову
    Selection.MoveUntil " ", 100
    Selection.MoveWhile " ", 100
  Loop While i > 0
End Sub