Выделение и копирование части документа на основе структуры файла

[satyr_of_frost]

Сообщение от viter.alex

Оптимизирую. Но очень быстрой работы не жди. Это же VBA, а не ассемблер. Он работает не с текстом, а с объектами, у которых куча свойств.

Понял, но подожду. Надежда, как грится, умирает последней. Я думал такие штуки по дефолту есть в его-величестве-ворде

UPD: Обновление оглавления! Оно работает в моем документе около 30 секунд. По сути-то оно делает что-то похожее - собирает инфомрацию о структуре файла.

[viter.alex]

Сообщение от satyr_of_frost

UPD: Обновление оглавления! Оно работает в моем документе около 30 секунд. По сути-то оно делает что-то похожее - собирает инфомрацию о структуре файла.

Не совсем так. Оглавление работает с ссылками. Нажми на оглавлении Alt+F9 увидишь, что jyj из себя представляет. Оно работает намного быстрее, потому что делается не на VBA, а на компилированном C++ или даже C#

[viter.alex]

Вот так. Ищет только в части документа от текущего параграфа до конца. Вот этот вариант, похоже, окончательный. Предыдущие искали неправильно, например, если после параграфа 2.4.5.6 сразу шел параграф 3, или 2.5, или 2.4.6, т.е. более высокого уровня, то выделялся фрагмент от текущего параграфа и вверх. Теперь же проверяются все уровни по очереди, пока не будет найден следующий абзац более высокого уровня. Работает довольно шустро. oRng.Select можно не делать, а сразу копировать диапазон в буфер. Просто так видно, что копируется

Sub selectpar()
  Dim par1 As Paragraph, ListL As Variant, oLP As ListParagraphs
  Dim iOutlineLevel As Integer, istart As Long, iend As Long, oRng As Range
  istart = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
  ListL = Split(Selection.Paragraphs(1).Range.ListFormat.ListString, ".")
  iOutlineLevel = UBound(ListL) + 1
  ListL(UBound(ListL)) = ListL(UBound(ListL)) + 1: ListL = Join(ListL, ".")
  With ActiveDocument
    'Диапазон для поиска, начиная с текущего и до последнего абзаца
    Set oLP = .Range _
              (.Paragraphs(istart).Range.Start, _
              .Paragraphs(.Paragraphs.Count).Range.End).ListParagraphs
    'Пока не найдем нужный параграф
    Do While iend = 0
      For Each par1 In oLP
        If ListL = par1.Range.ListFormat.ListString Then
          iend = .Range(0, par1.Range.End).Paragraphs.Count - 1
            Exit For
        End If
      Next par1
'      Если нужный параграф не найден, и еще не дошли до первого уровня
      If iOutlineLevel > 1 Then
        ListL = Left(ListL, InStrRev(ListL, ".") - 1)
        ListL = Split(ListL, ".")
        iOutlineLevel = UBound(ListL) + 1
        ListL(UBound(ListL)) = ListL(UBound(ListL)) + 1: ListL = Join(ListL, ".")
      End If
    Loop
    Set oRng = .Range(.Paragraphs(istart).Range.Start, _
              .Paragraphs(iend).Range.End)
  End With
  oRng.Select: oRng.Copy: oRng.Cut
End Sub

P.S. Правильно работать будет только с номерами, разделенными точкой.

Добавлено позже

Пока неправильно работает с 1 уровнем. Все остальные обрабатывает правильно.

[viter.alex]

Вот теперь совсем правильно. Все уровни вложенности (проверял до 5 включительно) работают. Проблема была во всякой мелочи, типа маркированных списков и пр. Кроме того, оказывается, что пункты находятся в коллекции ListParagraphs не по порядку номеров, а в порядке создания. Т.е. если я сначала создал пункт 8, а потом 7.9, то в коллекции они будут идти именно в таком порядке. Это увеличивает время поиска, если документ много раз редактировался, в него добавлялись пункты и пр. Да-а-а-а-а-а-а-а-а-а-а-а-а-а-а!

Sub SelectPar()
  Dim par1 As Paragraph, ListL As Variant, oLP As ListParagraphs
  Dim iOutlineLevel As Integer, iStart As Long, iEnd As Long, oRng As Range
  iStart = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
  iOutlineLevel = Selection.Paragraphs(1).Range.ListParagraphs(1).OutlineLevel
  ListL = Split(Selection.Paragraphs(1).Range.ListFormat.ListString, ".")
  ListL(UBound(ListL)) = ListL(UBound(ListL)) + 1: ListL = Join(ListL, ".")
  With ActiveDocument
    'Диапазон для поиска, начиная с текущего и до последнего абзаца
    Set oLP = .Range _
              (.Paragraphs(iStart).Range.Start, _
              .Paragraphs(.Paragraphs.Count).Range.End).ListParagraphs
    'Пока не найдем нужный параграф
    Do While iEnd = 0
      For Each par1 In oLP
        If par1.Range.ListParagraphs(1).OutlineLevel = iOutlineLevel Then
          If ListL = par1.Range.ListFormat.ListString Then
            iEnd = .Range(0, par1.Range.End).Paragraphs.Count - 1
            Exit For
          End If
'          Debug.Assert par1.Range.ListFormat.ListString = ListL
        End If
      Next par1
      'Если нужный параграф не найден, и еще не дошли до первого уровня вложености
      If iOutlineLevel > 1 Then
        'Отрезаем последнюю цифру
        ListL = Left(ListL, InStrRev(ListL, ".") - 1)
        'Определяем номер следующего абзаца для поиска
        ListL = Split(ListL, "."): iOutlineLevel = iOutlineLevel - 1
        ListL(UBound(ListL)) = ListL(UBound(ListL)) + 1: ListL = Join(ListL, ".")
      End If
    Loop
    Set oRng = .Range(.Paragraphs(iStart).Range.Start, _
              .Paragraphs(iEnd).Range.End)
  End With
  oRng.Select ': oRng.Copy: oRng.Cut
End Sub

[satyr_of_frost]

Так, пока тестирую, не работает для посленего куска в документе. Но это я так, случайно обнаружил, послений кусок можно и руками скопировать :-)

Если поставить на просто текст - вылетает ошибка, но это тоже не предъява.

Работает, корректно, но, увы 6 минут.

Давайте попробуем сменить концепцию:
1) начинаем обработку с позиции курсора (я ставлю курсор перед заголовком).
2)первый символ за курсором задает формат который мы сохраняем в некую переменную. (а можно и вообще hardcode сделать у меня всегда оин и тот же формат)
3)идем посимвольно вниз
4)начиная с 200-го символа проверяем формат символа, следующего за курсором. Если совпадает с сохраненным форматом - стоп, нашли следующий абзац.
5)выделяем от начал до момета "стоп"

Я понимаю, что это не общий случай и вообще костыль. Но фигли делать ;-)

Как тут поставить плюсы пользователю, те самые, что завуться репутацией?

UPD: я рботал с макро из сообщения от 10:39! При ламерском взгляде на новый макрос видно, что проблема с произвоительностью не исправится.

[viter.alex]

В блоке с аватарой в самой нижней строке вторая иконка слева
алгоритм странный
Зачем искать посимвольно? Ты знаешь сколько он будет пересчитывать посимвольно? Ты хочешь смотреть по 200 символов, а у тебя в документе найдется 200 нумерованых заголовков? Да и то, смотрит не все, а начиная с текущей позиции. С концом документа можно доработать, а может и сам сообразишь?

Добавлено после раздумий

Можно и по стилям смотреть, но не символов, а абзацев. Но, что будет если потом идет стиль более высокого уровня? Тогда оно перешагнет через этот уровень и подойдет дальше.

[satyr_of_frost]

Сообщение от viter.alex

В блоке с аватарой в самой нижней строке вторая иконка слева
алгоритм странный
Зачем искать посимвольно? Ты знаешь сколько он будет пересчитывать посимвольно? Ты хочешь смотреть по 200 символов, а у тебя в документе найдется 200 нумерованых заголовков? Да и то, смотрит не все, а начиная с текущей позиции. С концом документа можно доработать, а может и сам сообразишь?

Суть в том, что у главы, которую я хочу выделить, занимает 3-4 страницы. То есть явно больше 200 символов. Заголовок явно меньше 200 символов. Таким образом мы начнем проверять формат раньше чем глава кончилась, но позже, чем мы вышли из заголовка (заголово-то имеет искомый формат, на котором мы говорим "стоп"). На начало главы я легко встаю используя то, что называется "схема документа".
Проверять формат можно только для первого символа каждой строки (лечше для пятого, на случай невидимых пробелов).
Я бы с радостью писал и не мучал тебя тупорылыми задачами, но не знаю как:
1) достать формат
1.1) сравнить формат
2) устроить обход посимвольно от текущей позиции
3) ставить некие маркеры и потом выделять\копировать\вырезать от маркера до маркера.

я физик, не программер.

UPD По стилям круче? Можно и так. ОПисанный тобой исключительынй случай я буду иметь в виду и последнюю главу перед более высокоуровневым заголовком руками скопирую.

[viter.alex]

Я тоже не программер, а инженер.
Посимвольно это неправильно однозначно, потому что номер нам задает не символ, а стиль абзаца. Как я сразу не подумал? Ведь если у нас заголовок имеет стиль, например, «Заголовок 3», то, просматривая по абзацам, нужно искать абзац с таким же стилем, но с номером списка на 1 больше. Так можно делать, но сколько абзацев может быть между этими заголовками? У меня есть документ и там между заголовоками третьего уровня 18 страниц. Сколько абзацев не считал, но немало, да еще и вложенных заголовков до 5 уровня включительно. Конечно, можно ограничиться только сравнением стилей абзацев, которые имеют уровень, отличный от нулевого (т.е. те, которые отображаются в «Схеме документа» и в содержании.
Но здесь опять встает проблема с заголовком более высокого уровня, т.е. нужно еще проверять не только стиль , но и, чтобы уровень абзаца был равен или на 1 больше исходного. Пример: если искать абзац 3-го уровня. то нужно проверять, чтобы по дороге не попался абзац второго уровня. Одного сравнения стилей мало.
Теперь поясню как работает мой макрос:

1. Определяем номер начального абзаца в документе
2. Определяем цифры, которые стоят слева, т.е. номер в списке;
3. Прибавляем к этому номеру единицу, чтобы знать, что искать;
4. Определяем уровень этого абзаца в структуре документа (OutlineLevel);
5. Запоминаем диапазон (Range), начиная от этого абзаца и до конца документа;
6. Просматриваем списки выбраного диапазона (Range) на предмет совпадения номера и уровня;
7. Если просмотрели весь диапазон, но ничего не нашли, то убираем цифру из номера (переходим на уровень выше) и ищем уже заголовок более высокого уровня;
8. И так до тех пор, пока не найдем. Вот здесь нужно еще ставить проверку на конец документа;
9. Если нашли, то определяем номер найденого абзаца и выделяем диапазон от первого абзаца до найденого;
10. Дальше дело техники.

В общем я сделаю, а ты пробуй, какой быстрее будет. Можно еще таймер приделать

[satyr_of_frost]

Сообщение от viter.alex

Я тоже не программер, а инженер.
Посимвольно это неправильно однозначно, потому что номер нам задает не символ, а стиль абзаца. Как я сразу не подумал? Ведь если у нас заголовок имеет стиль, например, «Заголовок 3», то, просматривая по абзацам, нужно искать абзац с таким же стилем, но с номером списка на 1 больше. Так можно делать, но сколько абзацев может быть между этими заголовками? У меня есть документ и там между заголовоками третьего уровня 18 страниц. Сколько абзацев не считал, но немало, да еще и вложенных заголовков до 5 уровня включительно. Конечно, можно ограничиться только сравнением стилей абзацев, которые имеют уровень, отличный от нулевого (т.е. те, которые отображаются в «Схеме документа» и в содержании.
Но здесь опять встает проблема с заголовком более высокого уровня, т.е. нужно еще проверять не только стиль , но и, чтобы уровень абзаца был равен или на 1 больше исходного. Пример: если искать абзац 3-го уровня. то нужно проверять, чтобы по дороге не попался абзац второго уровня.

Структура документа у меня достаточно жестко регламентирована. В главе, которую надо выделить, меньше либо равно 20 подпунктов 4-го уровня, то есть максимум 20. Загловки разного уровня имеют разные стили, то есть заголовок третьего уровня имеет стиль, не совпадающий с форматом других уровней а форматы более высоких уровней известны. То есть стоп-форматы можно опрделить как множество.

[viter.alex]

Это понятно, я знаю как нужно делать нумерацию заголовков.
Пробуйте этот код. Работает быстрее. Даже кода меньше, чем в первом варианте. Комментарии достаточно полно описывают его работу. С простым текстом уже ошибки не будет, а вот с концом документа я еще работаю. Надеюсь получится.

Sub SelectParByStyle()
  'Если курсор находится не на заголовке, то заканчиваем процедуру
  If Selection.Range.Paragraphs.OutlineLevel = wdOutlineLevelBodyText Then Exit Sub
  Dim par1 As Paragraph, sStyle As String, bIsLast As Boolean
  Dim iOutlineLevel As Integer, iStart As Long, iEnd As Long
  'Запоминаем номер текущего абзаца
  iStart = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
  'Запоминаем его стиль
  sStyle = Selection.ParagraphFormat.Style
  'Запоминаем уровень в структуре документа
  iOutlineLevel = Selection.Paragraphs(1).Range.ListParagraphs(1).OutlineLevel
  With ActiveDocument
    'Запоминаем текущий абзац
    Set par1 = .Range _
              (.Paragraphs(iStart).Range.Start, _
              .Paragraphs(.Paragraphs.Count).Range.End).Paragraphs(1)
    'Перебираем все абзацы
    Do While iEnd = 0 'Пока номер конечного абзаца равен нулю, т.е. он не найден
      Set par1 = par1.Next 'Выбираем следующий абзац после текущего
'      bIsLast = .Range(0, par1.Range.End).Paragraphs.Count = .Paragraphs.Count
      'Если стиль абзаца равен стилю исходного, или уровень меньше исходного
      If par1.Style = sStyle Or _
         par1.OutlineLevel < iOutlineLevel Then 'Or bIsLast 
        iEnd = .Range(0, par1.Range.End).Paragraphs.Count - 1 'Запоминаем номер абзаца, который ему предшествует
'                CInt(Not (IsLast))
      End If
    Loop
    Set oRng = .Range(.Paragraphs(iStart).Range.Start, _
              .Paragraphs(iEnd).Range.End)
  End With
  oRng.Select ': oRng.Copy: oRng.Cut
End Sub