Word VBA Макросы: Заменить в сносках символ *

[Anton]

Здравствуйте!
Попался мне довольно большой текст, а со сносками в нем беда: вместо цифр - звездочки! Не знаю, чем руководствовался составитель, так в сносках трудно ориентироваться.
Можно ли исправить макросом звездочки на цифры по порядку? Помогите с решением пожалуйста. Файл приложил.

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

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

Макрос

Sub макрос()

    Dim i As Long
   
   
    '1. Отключение монитора (может это ускорит макрос и чтобы не мерцало).
    Application.ScreenUpdating = False
   
    '2. Настройка внешнего вида страничных сносок (есть ещё концевые сноски).
    With ActiveDocument.Range.FootnoteOptions
        .Location = wdBottomOfPage
        .NumberingRule = wdRestartContinuous
        .StartingNumber = 1
        .NumberStyle = wdNoteNumberStyleArabic
        .LayoutColumns = 0
    End With
   
    '3. Цикл по сноскам от последней к первой, т.к. имеющиеся сноски будут, как я понимаю, удаляться.
    For i = ActiveDocument.Footnotes.Count To 1 Step -1
        ' Вставка сноски в знак сноски.
            ' Это знак сноски в основном тексте (а не в сноске).
            ' Зачем нужно это - Reference:="" - пока не знаю, но без этого не работает.
        ActiveDocument.Footnotes.Add Range:=ActiveDocument.Footnotes(i).Reference, Reference:=""
    Next i
   
    '4. Включение монитора.
    Application.ScreenUpdating = True

End Sub

[свернуть]

[Anton]

На строчку
.LayoutColumns = 0
ругается на моем примере (method or data member not found)

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

Какая у вас версия ворда?

[Anton]

2010

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

Для "Word 2010":

Макрос

Sub макрос()

    Dim i As Long
   
   
    '1. Отключение монитора (может это ускорит макрос и чтобы не мерцало).
    Application.ScreenUpdating = False
   
    '2. Настройка внешнего вида страничных сносок (есть ещё концевые сноски).
    With ActiveDocument.Range.FootnoteOptions
        .Location = wdBottomOfPage
        .NumberingRule = wdRestartContinuous
        .StartingNumber = 1
        .NumberStyle = wdNoteNumberStyleArabic
    End With
   
    '3. Цикл по сноскам от последней к первой, т.к. имеющиеся сноски будут, как я понимаю, удаляться.
    For i = ActiveDocument.Footnotes.Count To 1 Step -1
        ' Вставка сноски в знак сноски.
            ' Это знак сноски в основном тексте (а не в сноске).
            ' Зачем нужно это - Reference:="" - пока не знаю, но без этого не работает.
        ActiveDocument.Footnotes.Add Range:=ActiveDocument.Footnotes(i).Reference, Reference:=""
    Next i
   
    '4. Включение монитора.
    Application.ScreenUpdating = True

End Sub

[свернуть]

[Anton]

Сработало! Большое спасибо!
А подскажите пожалуйста, можно ли как-то определить, что в документе есть такие неправильные сноски? Чтобы быть предупрежденным, что такие сноски будут заменены!

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

Здесь две процедуры, запускайте только процедуру "макрос", вторая запустится процедурой "макрос".

Макрос

Sub макрос()

    Dim i As Long
   
   
    '1. Если в файле нет сносок в виде звёздочек.
    If VerifyFootnotes = False Then
        Exit Sub
    End If
   
    '2. Отключение монитора (может это ускорит макрос и чтобы не мерцало).
    Application.ScreenUpdating = False
   
    '3. Настройка внешнего вида страничных сносок (есть ещё концевые сноски).
    With ActiveDocument.Range.FootnoteOptions
        .Location = wdBottomOfPage
        .NumberingRule = wdRestartContinuous
        .StartingNumber = 1
        .NumberStyle = wdNoteNumberStyleArabic
    End With
   
    '4. Цикл по сноскам от последней к первой, т.к. имеющиеся сноски будут, как я понимаю, удаляться.
    For i = ActiveDocument.Footnotes.Count To 1 Step -1
        ' Вставка сноски в знак сноски.
            ' Это знак сноски в основном тексте (а не в сноске).
            ' Зачем нужно это - Reference:="" - пока не знаю, но без этого не работает.
        ActiveDocument.Footnotes.Add Range:=ActiveDocument.Footnotes(i).Reference, Reference:=""
    Next i
   
    '5. Включение монитора.
    Application.ScreenUpdating = True
   
    '6. Сообщение.
    MsgBox "Готово"

End Sub

Private Function VerifyFootnotes() As Boolean

    Dim footnote As footnote
   
    ' Цикл по всем страничным сноскам (есть ещё концевые сноски).
    For Each footnote In ActiveDocument.Footnotes
        ' Если знак сноски в виде звёздочки.
        If footnote.Reference.Text = "*" Then
            ' Запись в переменную-функцию слова "True".
            VerifyFootnotes = True
            ' Выход из функции.
            Exit Function
        End If
    Next footnote
   
    MsgBox "В файле нет сносок в виде ""*"".", vbInformation

End Function

[свернуть]

[Anton]

Спасибо! За комментарии к коду отдельная благодарность!