Форум по VBA и MS Office

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

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

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