Добрый день!
У меня есть несколько документов, где дублируются сноски. Сложно иногда заметить.
Помогите пожалуйста с макросом, который такие сноски находит и выделяет с помощью выделения абзаца. Пример приложил.
[вложение удалено администратором]
Для одной сноски сделать две сноски вроде нельзя? Это брак в ворде? Или это можно сделать?
Хотя сейчас я скопировал абзац в сносках и вставил. Видимо так было это сделано.
Я тоже не смог повторить, думал, как ошибку исправить, а потом понял, что автоматически никак, остается только найти.
Я смог повторить (смотрите ответ #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
Большое спасибо!
Проверил несколько текстов, оказалось, упустил все-таки еще в одном месте. Очень полезный макрос!
Искать страницу, несмотря на заливку абзаца, замучился, в документе 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
Даже так! Большое спасибо! Очень здорово!