1 Тема от Alex_dolg

  • Alex_dolg
  • рядовой
  • Неактивен
  • Зарегистрирован: 05.11.2016
  • Сообщений: 3

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

Добрый день!

Я редактор, вычитываю тексты в ворде. Найденные ошибки отмечаю в примечаниях маркировкой из латинской буквы и цифры (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 и т.д.) как в стандартной форме поиска ворда и не записывает результаты в документ.

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

Спасибо!

2 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

Alex_dolg пишет:

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

Хочу отметить, что оператор ActiveWindow.Panes(2).Activate для поиска по примечаниям не всегда может корректно сработать, если в Word открыты и другие панели.
Мой вариант решения вашей задачи см. ниже

Sub FootnoteReviewStatistics()
Dim FNSRange As Range 'диапазон примечаний
Dim para As Paragraph
Dim parauptext As String
Dim irev As Long
Dim allnrev As Long 'всего замечаний
Dim msgstr As String
Dim revstat(1 To 9) As Long 'массив статистики частных замечаний по типам 1..9

Set FNSRange = Nothing
On Error Resume Next
Set FNSRange = ActiveDocument.StoryRanges(wdFootnotesStory)
On Error GoTo 0
If Not (FNSRange Is Nothing) Then
    For irev = 1 To 9
        revstat(irev) = 0
    Next irev
    allnrev = 0
    For Each para In FNSRange.Paragraphs
        parauptext = UCase$(para.Range.Text)
        If parauptext Like "*F1*" Then
            revstat(1) = revstat(1) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F2*" Then
            revstat(2) = revstat(2) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F3*" Then
            revstat(3) = revstat(3) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F4*" Then
            revstat(4) = revstat(4) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F5*" Then
            revstat(5) = revstat(5) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F6*" Then
            revstat(6) = revstat(6) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F7*" Then
            revstat(7) = revstat(7) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F8*" Then
            revstat(8) = revstat(8) + 1: allnrev = allnrev + 1
        ElseIf parauptext Like "*F9*" Then
            revstat(1) = revstat(9) + 1: allnrev = allnrev + 1
        End If
    Next
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    msgstr = "-------------------------------------------------------------------------------"
    Selection.TypeText msgstr
    Selection.TypeParagraph
    msgstr = "Статистика рецензии. Дата = " & CStr(Date) & " Время = " & CStr(Time)
    Selection.TypeText msgstr
    If allnrev = 0 Then
        msgstr = "Нет замечаний"
        Selection.TypeText msgstr
    Else
        For irev = 1 To 9
            If revstat(irev) > 0 Then
                Selection.TypeParagraph
                msgstr = "Ошибок типа " & "F" & CStr(irev) & " - " & CStr(revstat(irev))
                Selection.TypeText msgstr
            End If
        Next irev
    End If
Else
    MsgBox "В документе нет примечаний"
End If
Set FNSRange = Nothing
End Sub

Сайтyshindin

3 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171
  • За сообщение: 1

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

yshindin пишет:

Мой вариант решения вашей задачи см. ниже

Заметил опечатку в своем коде:

            revstat(1) = revstat(9) + 1: allnrev = allnrev + 1

должно, конечно же, быть 

            revstat(9) = revstat(9) + 1: allnrev = allnrev + 1

Сайтyshindin

4 Ответ от Alex_dolg

  • Alex_dolg
  • рядовой
  • Неактивен
  • Зарегистрирован: 05.11.2016
  • Сообщений: 3

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

Спасибо!

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

Видимо, я что-то делаю не так?

yshindin, я вам написал в личку, посмотрите пожалуйста smile

5 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

Alex_dolg пишет:

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

Под примечаниями я понял сноски (footnotes), что размещаются в нижней части листа при добавлении сносок. А вы что-то другое имели в виду, м.б., комментарии? Выложите, пжл, пример вашего документа с пометками F1 ... F9.

Сайтyshindin

6 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

yshindin пишет:

Под примечаниями я понял сноски (footnotes), что размещаются в нижней части листа при добавлении сносок.

Вот прицепил пример документа, на котором отлаживался.

Post's attachments

FNSRange.docm 38.4 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.

Сайтyshindin

7 Ответ от Alex_dolg

  • Alex_dolg
  • рядовой
  • Неактивен
  • Зарегистрирован: 05.11.2016
  • Сообщений: 3

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

yshindin пишет:
Alex_dolg пишет:

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

Под примечаниями я понял сноски (footnotes), что размещаются в нижней части листа при добавлении сносок. А вы что-то другое имели в виду, м.б., комментарии? Выложите, пжл, пример вашего документа с пометками F1 ... F9.

Да, я имел в виду именно комментарии. В русском ворде они называются примечаниями. Извините, похоже случайно ввел вас в заблуждение.

8 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171

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

Alex_dolg пишет:

Да, я имел в виду именно комментарии. В русском ворде они называются примечаниями.

Тогда вместо цикла по абзацам сносок делаем двойной цикл: по комментариям, а внутри них - цикл по абзацам текста комментария. В прицепе отладочный демо-файл.

Sub CommentReviewStatistics()
Dim para As Paragraph
Dim cmt As Comment
Dim cmtcnt As Long
Dim parauptext As String
Dim irev As Long
Dim allnrev As Long 'всего замечаний
Dim msgstr As String
Dim revstat(1 To 9) As Long 'массив статистики частных замечаний по типам 1..9

cmtcnt = ActiveDocument.Comments.Count
If cmtcnt > 0 Then
    For irev = 1 To 9
        revstat(irev) = 0
    Next irev
    allnrev = 0
    For Each cmt In ActiveDocument.Comments 'цикл по примечаниям
        For Each para In cmt.Range.Paragraphs 'цикл по абзацам примечаний
            parauptext = UCase$(para.Range.Text)
            If parauptext Like "*F1*" Then
                revstat(1) = revstat(1) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F2*" Then
                revstat(2) = revstat(2) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F3*" Then
                revstat(3) = revstat(3) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F4*" Then
                revstat(4) = revstat(4) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F5*" Then
                revstat(5) = revstat(5) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F6*" Then
                revstat(6) = revstat(6) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F7*" Then
                revstat(7) = revstat(7) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F8*" Then
                revstat(8) = revstat(8) + 1: allnrev = allnrev + 1
            ElseIf parauptext Like "*F9*" Then
                revstat(9) = revstat(9) + 1: allnrev = allnrev + 1
            End If
        Next
    Next
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    msgstr = "-------------------------------------------------------------------------------"
    Selection.TypeText msgstr
    Selection.TypeParagraph
    msgstr = "Статистика рецензии. Дата = " & CStr(Date) & " Время = " & CStr(Time)
    Selection.TypeText msgstr
    If allnrev = 0 Then
        msgstr = "Нет замечаний"
        Selection.TypeText msgstr
    Else
        For irev = 1 To 9
            If revstat(irev) > 0 Then
                Selection.TypeParagraph
                msgstr = "Ошибок типа " & "F" & CStr(irev) & " - " & CStr(revstat(irev))
                Selection.TypeText msgstr
            End If
        Next irev
    End If
Else
    MsgBox "В документе нет примечаний"
End If
End Sub
Post's attachments

CmtStatRange.docm 41.05 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.

Сайтyshindin