Word Макрос: Проверить сноски на дублирование

[Anton]

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

[вложение удалено администратором]

[Администратор]

Для одной сноски сделать две сноски вроде нельзя? Это брак в ворде? Или это можно сделать?
Хотя сейчас я скопировал абзац в сносках и вставил. Видимо так было это сделано.

[Anton]

Я тоже не смог повторить, думал, как ошибку исправить, а потом понял, что автоматически никак, остается только найти.

[Администратор]

Я смог повторить (смотрите ответ #1).

[Администратор]

Макрос закрашивает абзац целиком, где есть дублированная сноска, и сам знак сноски, чтобы юзеру было удобнее найти.

Макрос

Sub макрос()
   
    Dim counter As Long
   
    If ActiveDocument.Footnotes.Count <> 0 Then
        FindDupls ActiveDocument.Footnotes, counter
    End If
    If ActiveDocument.Endnotes.Count <> 0 Then
        FindDupls ActiveDocument.Endnotes, counter
    End If
   
    If counter = 0 Then
        MsgBox "Дублированных сносок нет.", vbInformation
    Else
        MsgBox "Кол-во дублированных сносок: " & counter, vbExclamation
    End If
   
End Sub

Private Sub FindDupls(notes As Object, counter As Long)
   
    Dim note As Object, i As Long
   
    ' Цикл по сноскам (страничным или концевым).
    For Each note In notes
        ' Цикл по абзацам сноски в области сносок. Если в каком-либо абзаце первый
            ' символ специфический, значит это знак сноски. Значит в одной сноске
            ' есть несколько абзацев со знаком сноски.
        For i = 2 To note.Range.Paragraphs.Count
            If Asc(note.Range.Paragraphs(i).Range.Characters(1).text) = 2 Then
                note.Reference.Paragraphs(1).Range.Shading.BackgroundPatternColor = 10079487
                note.Reference.Shading.BackgroundPatternColor = 5263615
                counter = counter + 1
                Exit For
            End If
        Next i
    Next note

End Sub

[свернуть]

[Anton]

Большое спасибо!
Проверил несколько текстов, оказалось, упустил все-таки еще в одном месте. Очень полезный макрос!

[Anton]

Искать страницу, несмотря на заливку абзаца, замучился, в документе 360 с. А можно как-то запоминать номера страниц с такими сносками?

[Администратор]

После работы макроса, макрос создаёт ворд-файл и вставляет в него номера страниц, где найдены дублированные сноски.

Макрос

Sub макрос()
   
    Dim doc_errors As Document, errors As String
   
    If ActiveDocument.Footnotes.Count <> 0 Then
        FindDupls ActiveDocument.Footnotes, errors
    End If
    If ActiveDocument.Endnotes.Count <> 0 Then
        FindDupls ActiveDocument.Endnotes, errors
    End If
   
    If errors = "" Then
        MsgBox "Дублированных сносок нет.", vbInformation
    Else
        MsgBox "Есть дублированные сноски. Смотрите ворд-файл с номерами страниц.", vbExclamation
        Set doc_errors = Documents.Add
        doc_errors.Range = errors
    End If
   
End Sub

Private Sub FindDupls(notes As Object, errors As String)
   
    Dim note As Object, i As Long
   
    ' Цикл по сноскам (страничным или концевым).
    For Each note In notes
        ' Цикл по абзацам сноски в области сносок. Если в каком-либо абзаце первый
            ' символ специфический, значит это знак сноски. Значит в одной сноске
            ' есть несколько абзацев со знаком сноски.
        For i = 2 To note.Range.Paragraphs.Count
            If Asc(note.Range.Paragraphs(i).Range.Characters(1).text) = 2 Then
                note.Reference.Paragraphs(1).Range.Shading.BackgroundPatternColor = 10079487
                note.Reference.Shading.BackgroundPatternColor = 5263615
                errors = errors & note.Reference.Information(wdActiveEndPageNumber) & Chr(13)
                Exit For
            End If
        Next i
    Next note

End Sub

[свернуть]

[Anton]

Даже так! Большое спасибо! Очень здорово!