Помогите с макросом: поиск и подсчет словосочетаний в примечаниях

[Alex_dolg]

Добрый день!

Я редактор, вычитываю тексты в ворде. Найденные ошибки отмечаю в примечаниях маркировкой из латинской буквы и цифры (F1, F2, F3 и прочие, всего 9 маркировок).
После вычитки нужно посчитать, сколько раз отмеченные ошибки встречаются в документе. Например, ошибки, отмеченные маркировкой F1 - 9 раз, ошибки F2 - 5 раз, и так далее.

Сейчас я делаю это стандартным поиском по примечаниям: Ctrl+F, потом Найти в: Примечания. Приходится выполнять одни и те же действия девять раз подряд. Хочу автоматизировать эту процедуру макросом: чтобы искал по примечаниям все 9 маркировок, а потом добавлял результат в конец документа, например, "Ошибок F1 - 9, Ошибок F2 - 5", и так далее.

Поскольку VBA не знаю, попробовал просто записать свой поиск в ворде. Вот что получилось:

Sub Макрос1()
'
' Макрос1 Макрос
'
'
    ActiveWindow.Panes(2).Activate
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "F1"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "F2"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "F3"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
End Sub

Получившийся макрос меня совсем не радует, так как он не подсчитывает найденные маркировки ошибок (F1, F2 и т.д.) как в стандартной форме поиска ворда и не записывает результаты в документ.

Понимаю, что задача наверное банальная, но разобраться пока не могу. Подскажите плиз, какими операторами считать результаты поиска и записывать их в документ. Учебники читаю, но пока не докумекал.

Спасибо!

[Step_UA]

Sub FFF()
  Dim El As Comment, s$, f$, r$, i%, j&, c&
    For Each El In ActiveDocument.Comments
        s = s & El.Range.Text & " "
    Next
    
    For i = 1 To 9
        f = "F" & i: c = 0
        j = InStr(1, s, f, vbTextCompare)
        While j > 0
            c = c + 1
            j = InStr(j + 1, s, f, vbTextCompare)
        Wend
        If c > 0 Then r = r & ", Ошибок " & f & " - " & c
    Next
    If r <> "" Then ActiveDocument.Range.InsertAfter (vbNewLine & Mid(r, 2))
End Sub

[Alex_dolg]

Step_UA, класс, работает, именно то что нужно! Буду потихоньку разбираться на этом примере, какая строка что делает.

Я вам отправил чисто символическое спасибо на яндекс-кошелек

Осталось два вопроса:
1. Можно ли сделать так, чтобы каждый результат добавлялся с новой строки:
F1 - ...
F2 - ... и т.д.

2. Умеете ли вы в вещи вроде этого: https://ru.wikipedia.org/wiki/Schematron? Возможно, потребуется решить несколько задач, связанных с XPath.

Еще раз спасибо!

[Step_UA]

Спасибо!
1.

' замените строку
If c > 0 Then r = r & ", Ошибок " & f & " - " & c
' на
If c > 0 Then r = r & vbLf & "Ошибок " & f & " - " & c

2. Весьма поверхностно