Word VBA: Как отсортировать разделы с помощью макроса?

Автор Посетитель, 24 декабря 2015, 22:42

Посетитель

Добрый вечер! А помогите пожалуйста написать макрос, который сортирует разделы в соответствии с ключевой фразой в тексте. Например, у меня есть разделы и каждый начинается со слов  1Раздел, 5Раздел, 2Раздел и т.п. Можно ли сделать так, чтобы они сортировались по возрастанию номера раздела автоматически (переносились на нужное место сами)? Разделы разные, есть большие, с графикой и таблицами, а есть просто с текстом.

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

После работы макроса будут сбиваться следующие элементы:

  • колонтитулы;
  • параметры страниц;
  • автоматические (не сделанные от руки) списки.

Макрос
Sub Main_SortSections()

    Dim docAct As Word.Document, sec As Word.Section
    Dim arrIndexes() As Long, i As Long
   
   
    '1. Vba-именование активного файла.
    Set docAct = ActiveDocument
   
    '2. Проверка, что в каждом разделе, в первом абзаце есть нужная фраза.
    For i = 1 To docAct.Sections.Count Step 1
        If Not docAct.Sections(i).Range.Paragraphs(1).Range.Text Like "*#Раздел*" Then
            docAct.Sections(i).Range.Paragraphs(1).Range.Select
            MsgBox "В этом абзаце (он выделен) нет фразы вида #Раздел.", vbExclamation
            Exit Sub
        End If
    Next i
   
    '3. Вставка разрыва раздела перед первым разделом, иначе после
        ' переносов первый раздел войдёт в состав другого раздела.
    docAct.Range(0, 0).InsertBreak Type:=wdSectionBreakNextPage

    '4. Извлечение порядковых номеров из фраз типа "1Раздел" в массив.
    Call pExtractIndexes(docAct, arrIndexes())
   
    '5. Вставка закладок в разделы. В эти закладки записываются порядковые номера разделов.
        ' Закладки нужны, т.к. после каждой перестановки расположение разделов будет изменяться.
    ' Первый раздел не учитывается, т.к. был вставлен макросом.
    For i = 2 To docAct.Sections.Count Step 1
        Set sec = docAct.Sections(i)
        docAct.Range(sec.Range.Start, sec.Range.Start).Bookmarks.Add Name:="Макрос_раздел_" & arrIndexes(i)
    Next i
   
    For i = docAct.Sections.Count To 2 Step -1
        '6. Перестановка раздела.
        docAct.Bookmarks("Макрос_раздел_" & i).Range.Sections(1).Range.Cut
        docAct.Range(0, 0).Paste
        '7. Удаление закладки, чтобы не засоряла файл.
        docAct.Bookmarks("Макрос_раздел_" & i).Delete
    Next i
   
    '8. Удаление последнего разрыва раздела. Его создал макрос в начале своей работы.
    docAct.Sections.Last.Range.Characters(1).Previous.Delete
   
    '9. Копирование любого небольшого фрагмента, чтобы после закрытия программы "Word"
        ' не было сообщения, что в буфере содержатся данные.
    docAct.Sections(1).Range.Characters(1).Copy
   
    '10. Сообщение.
    MsgBox "Макрос завершил работу.", vbInformation

End Sub

Private Sub pExtractIndexes(docAct As Word.Document, arrIndexes() As Long)
   
    ' Извлечение порядковых номеров из фраз типа "1Раздел" в массив.
   
    Dim sec As Word.Section, stri As String, i As Long, j As Long
   
   
    '1. Создание ячеек в массиве.
    ReDim arrIndexes(1 To docAct.Sections.Count)
   
    '2.
    ' Первый раздел создан макросом и пустой.
    For i = 2 To docAct.Sections.Count Step 1
        '1) Vba-именование раздела.
        Set sec = docAct.Sections(i)
        '2) Копирование первого абзаца в переменную.
        stri = sec.Range.Paragraphs(1).Range.Text
        '3) Извлечение фразы.
        ' Удаление текста до первой цифры.
            ' Спереди может быть разрыв страницs. Вероятно, ещё что-то может быть.
        For j = 1 To Len(stri) Step 1
            If Mid(stri, j, 1) Like "#" Then
                stri = Mid(stri, j)
                Exit For
            End If
        Next j
        '4) Извлечение числа. Корректировка порядкового номера с учётом того,
            ' что макрос создал в начале файла раздел.
        arrIndexes(i) = Val(stri) + 1
    Next i
   
End Sub
[свернуть]

Посетитель

Да, сейчас проверил - работает! Большое спасибо!

Anton

Интересная тут тема.
Могу я автора макроса попросить посмотреть мой текст (я заменил буквы, рабочие материалы). У меня почему-то выдает ошибку при сортировке.

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

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

Для макроса нужно, чтобы номера вида "#Раздел" шли по порядку.

Я выписал ваши номера:
Спойлер
1
2
3
4
5
6
7
9
10
11
12
13
14
15
16
18
19
20
21
22
23
[свернуть]

Пропущены 8 и 17. Видимо ошибка из-за этого. Я уже сам тяжело ориентируюсь в коде (с ходу не могу вникнуть в код).