Форум по VBA и MS Office

Sub Макрос()
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Если курсор находится в области страничных сносок.
    If Selection.Range.StoryType = wdFootnotesStory Then
        Call Procedure1(Selection.Footnotes, ActiveDocument.Footnotes, wdStyleFootnoteReference, wdStyleFootnoteText)
    '3. Если курсор находится в области концевых сносок.
    ElseIf Selection.Range.StoryType = wdEndnotesStory Then
        Call Procedure1(Selection.Endnotes, ActiveDocument.Endnotes, wdStyleEndnoteReference, wdStyleEndnoteText)
    End If
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub

Private Sub Procedure1(SelNotes As Object, DocNotes As Object, _
                        lngRefStyle As WdBuiltinStyle, lngTextStyle As WdBuiltinStyle)

    Dim cln As New Collection, nt As Object, sel As Range
    Dim i As Long

   
    '1. Запоминаем, какие сноски выделены, т.к. потом надо будет выделять каждую сноску и
        ' первоначальное выделение будет сбито.
        ' For Each не используется, т.к. просматриваются все сноски, а не только выделенные.
    For i = 1 To SelNotes.Count Step 1
        cln.Add Item:=SelNotes(i).Index
    Next i
   
    '2. Запоминание выделенного фрагмента, чтобы после работы макроса выделить этот же фрагмент
        ' для удобства юзера.
    Set sel = Selection.Range.Duplicate
   
    '3. Сброс оформления. Чтобы сбросить оформление нужно использовать "Selection".
        ' С помощью "Range" нельзя сбросить оформление, если во фрагменте несколько стилей.
    For i = 1 To cln.Count Step 1
   
        '1) Vba-именование сноски.
        Set nt = DocNotes(cln(i))
       
        '2) Сброс оформления у номера сноски.
        nt.Range.Paragraphs(1).Range.Characters(1).Style = lngRefStyle
       
        '3) Сброс оформления у текста сноски.
        '* Выделение текста сноски.
        nt.Range.Select
        '* Включение в выделение левого пробела, чтобы у него было такое же оформление.
        Selection.MoveStartWhile Cset:=" ", Count:=wdBackward
        '* Делаем в тексте один стиль.
        Selection.ClearFormatting
        '* Применение нужного стиля.
        Selection.Style = lngTextStyle
       
        '4) Сброс оформления у знака абзаца. Нужно выделять, иначе стиль не меняется.
        nt.Range.Paragraphs(1).Range.Characters.Last.Select
        Selection.Style = lngTextStyle
       
        '5) Применение стиля ко всему абзацу, чтобы в списке стилей отображался стиль "Текст сноски",
            ' а не "Обычный". При этом номер сноски не сбивается.
        nt.Range.Paragraphs(1).Style = lngTextStyle
       
    Next i
   
    '4. Выделение первоначального выделения.
    sel.Select

End Sub

Sub Макрос()

    Dim rngSel As Range, i As Long
   
   
    '1. Проверка, что курсор находится внутри области сносок.
    Select Case Selection.Range.StoryType
        Case wdFootnotesStory, wdEndnotesStory
        Case Else
            Exit Sub
    End Select
   
    '2. Отключение монитора.
    Application.ScreenUpdating = False
   
    '3. Vba-именование выделенного фрагмента с включением начала первого абзаца и
        ' с включением конца последнего абзаца. Т.к. в одной сноске может быть несколько абзацев.
    Set rngSel = Selection.Range
    rngSel.SetRange Selection.Range.Paragraphs(1).Range.Start, Selection.Range.Paragraphs.Last.Range.End
   
    '4. Если курсор находится в области страничных сносок.
    If Selection.Range.StoryType = wdFootnotesStory Then
   
        ' Сброс оформления у выделенных абзацев.
        rngSel.Style = wdStyleFootnoteText
        rngSel.Font.Reset
        rngSel.ParagraphFormat.Reset
        ' Задание стиля номерам сносок.
        For i = 1 To rngSel.Footnotes.Count Step 1
            rngSel.Footnotes(i).Range.Paragraphs(1).Range.Characters(1).Style = wdStyleFootnoteReference
        Next i
       
    '5. Если курсор находится в области концевых сносок.
    ElseIf Selection.Range.StoryType = wdEndnotesStory Then
       
        ' Сброс оформления у выделенных абзацев.
        rngSel.Style = wdStyleEndnoteText
        rngSel.Font.Reset
        rngSel.ParagraphFormat.Reset
        ' Задание стиля номерам сносок.
        For i = 1 To rngSel.Endnotes.Count Step 1
            rngSel.Endnotes(i).Range.Paragraphs(1).Range.Characters(1).Style = wdStyleEndnoteReference
        Next i
       
    End If
   
    '6. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub