Добрый день! Подскажите пожалуйста, как исправить ситуацию со сносками.
Первый файл
Здесь знак сноски в основном тексте выглядит как просто текст, но ворд считает такую сноску сноской. Нужно преобразовать такой знак сноски в обычный знак сноски, окружённый пунктирной границей. Пунктирную границу видно в режиме непечатаемых символов.
Второй файл
Здесь знаки сносок в области сносок просто напечатаны от руки. Нужно их заменить на обычные знаки сноски, чтобы знаки сносок были окружены пунктирной границей. Пунктирную границу видно в режиме непечатаемых символов.
Макрос работает при условии, что в области сносок, после псевдознака сноски есть пробел (обычный или неразрывный).
Если пробела нет, то макрос удалит нужный текст до первого пробела или если в абзаце нет пробелов, то произойдёт ошибка во время работы макроса.
Поместите все три процедуры в один модуль. Запускайте процедуру "макрос".
Макрос
Sub макрос()
'1. Отключение монитора (может это ускорит макрос и чтобы не мерцало).
Application.ScreenUpdating = False
'2. Изменение номеров сносок в основном тексте.
'1) Работа со страничными сносками.
ChangeMainArea ActiveDocument.Footnotes
'2) Работа с концевыми сносками.
ChangeMainArea ActiveDocument.Endnotes
'3. Изменение номеров сносок в области сносок.
'1) Работа со страничными сносками.
ChangeNotesArea ActiveDocument.Footnotes
'2) Работа с концевыми сносками.
ChangeNotesArea ActiveDocument.Endnotes
'4. Включение монитора.
Application.ScreenUpdating = True
End Sub
Private Sub ChangeMainArea(notes As Object)
' Изменение номеров сносок в основном тексте.
' Есть случаи, когда номер сноски не в виде специального символа,
' внутри пунктирной границы, а просто в виде числа. Но это не
' просто псевдосноска, т.к. ворд распознаёт такую сноску, как сноску.
Dim note As Object, i As Long
' Если нет сносок, то выход из процедуры.
If notes.Count = 0 Then
Exit Sub
End If
' Нужно двигаться от последней к первой, иначе что-то непонятное происходит.
' Наверное, происходит удаление сноски и создание новой.
For i = notes.Count To 1 Step -1
' Присваиваем сноке имя "note", чтобы было удобно писать и читать код.
Set note = notes(i)
' Если сноска не имеет пунктирного обрамления.
If Asc(note.Reference.text) <> 2 Then
' Вставка сноски прямо в имеющуюся сноску.
note.Reference.Footnotes.Add Range:=note.Reference, Reference:=""
End If
Next i
End Sub
Private Sub ChangeNotesArea(notes As Object)
' Изменение номеров сносок в области сносок.
Dim note As Object, rng As Range
' Если нет сносок, то выход из процедуры.
If notes.Count = 0 Then
Exit Sub
End If
For Each note In notes
If Asc(note.Range.Paragraphs(1).Range.Characters(1).text) <> 2 Then
note.Reference.Copy
Set rng = note.Range.Paragraphs(1).Range.Characters(1)
' Движение конца фрагмента до пробела.
rng.MoveEndUntil Cset:=" " & Chr(160)
rng.PasteAndFormat wdFormatOriginalFormatting
End If
Next note
End Sub