[решено] Нумерация каждого списка в документе заново

[Казбек]

Добрый вечер.
Есть документ на 2000 тысячи страниц, doc-формата. Структура документа такова, что через каждые пару страниц встречаются списки. Их все нужно пронумеровать начиная с 1, а не как единый большой список.
Благодарю.

[Iska]

Раньше было так — назначил потребный список (лучше всего — отдельным стилем), затем в нужном месте ПКМ по абзацу, «Начать заново»:
https://i.imgur.com/QhMkB1v.png
Как в Office 2010 — не знаю, не пробовал.

[Казбек]

Iska,

Суть в том, что списков много, каждый раз щелкать "Начать заново" - утомительно. Хотелось бы это сделать средствами офиса, с помощью тех же макросов или как-то еще, обходным путем.

Добавлено.
Еще один нюанс, возможно, это поможет реализовать затею. Текст перед списками всегда одинаковый, как и сами списки.

[Iska]

Казбек, а как Word или макрос определит, что есть список, где его начало и где конец? Таковой алгоритм либо должны определить Вы (для макроса), либо передоверить сие Word'у, воспользовшись автоформатированием — \Формат\Автоформат…:
https://i.imgur.com/2VTnwLI.png
убрав все флажки, кроме потребного, со вкладки Автоформат диалогового окна Автозамена, доступного из вышеуказанного диалогового окна по кнопке Параметры…:
https://i.imgur.com/rvfCtZh.png
P.S. Примеры, опять же, для версии Microsoft Office 2003.

[Казбек]

а как Word или макрос определит, что есть список, где его начало и где конец? »
Добавлено.
Еще один нюанс, возможно, это поможет реализовать затею. Текст перед списками всегда одинаковый, как и сами списки. »

[Iska]

Цитата Казбек:
Добавлено. »
Минус данной реализации движка в том, что он никак не показывает, ни то, что сообщение, на которое ты отвечаешь, было изменено, ни то, что в тему были добавлены ответы. Увы.

Попробуйте Автоформат. Если не выйдет — пишите, будем думать над макросом.

[Казбек]

Попробуйте Автоформат. Если не выйдет — пишите, будем думать над макросом. »

К сожалению, вообще ничего не произошло.

[Iska]

Тогда думайте над алгоритмом и излагайте, мне — образец документа с несколькими реальными примерами списков в архиве.

[Казбек]

Iska,

Структура документа примерно следующая, то есть, весь документ абсолютно цикличен, как в образце. Похожая тема есть здесь (https://stackoverflow.com/questions/26567257/word-2010-vba-macro-to-restart-numbered-lists). Возможно, вам чем-то это поможет.

Тогда думайте над алгоритмом и излагайте »

Что-то типа этого (http://www.msofficeforums.com/word-vba/38852-vba-find-word-create-numbered-list-under.html). Согласны?
То есть, я убираю изначально все списки, а потом мы начинаем нумерацию всего, что после слова "додатки" и заканчиваем этот список после слова "довіреності". И так делаем циклично, годиться?

[Iska]

Казбек, попробуйте вставить в модуль «ThisDocument» искомого документа и выполнить следующий код макроса:
Option Explicit

Sub Sample()
Dim objParagraph As Paragraph
Dim boolStartNum As Boolean
Dim lngStartCharacter As Long
Dim lngEndCharacter As Long


boolStartNum = False

For Each objParagraph In ThisDocument.Content.Paragraphs
If StrComp(Trim(Replace(objParagraph.Range.Text, vbCr, "")), "Додатки:", vbTextCompare) = 0 Then
boolStartNum = True
lngStartCharacter = objParagraph.Range.Characters.Last.End
Else
If boolStartNum Then
If StrComp(Trim(Replace(objParagraph.Range.Text, vbCr, "")), "Копія довіреності", vbTextCompare) = 0 Then
boolStartNum = False
lngEndCharacter = objParagraph.Range.Characters.Last.End

With ThisDocument.Range(lngStartCharacter, lngEndCharacter).ListFormat
.RemoveNumbers NumberType:=wdNumberParagraph
.ApplyListTemplate _
ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1), _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList, _
DefaultListBehavior:=wdWord10ListBehavior
End With
End If
End If
End If
Next
End Sub

[Казбек]

попробуйте вставить в модуль «ThisDocument» искомого документа и выполнить следующий код макроса »

Прошу прощения, не совсем ясно, что я должен проделать... Можете более подробно описать эту процедуру, особенно, что касается текста "ThisDocument". Спасибо.

[Iska]

Открыть искомый документ. Нажать Alt-F11, открыв Редактор VBA. Найти в окне Project Explorer (если этого окна не видно — нажать Ctrl-R) проект искомого документа, раскрыть его (если потребно), развернуть до модуля ThisDocument, щёлкнуть по последнему правой кнопкой мышки, в появившемся контекстном меню выбрать View Code (или просто выделить модуль и нажать F7):
https://i.imgur.com/vl6gWJK.png
В открывшееся окно вставить скопированный код со страницы конференции. Теперь можно выполнить код этого макроса (проще всего установить курсор где-нибудь внутри процедуры и нажать F5). Сам код впоследствии, после отработки, можно просто удалить.

[Казбек]

Iska,

Почти превосходно. Два момента:

Подлатайте, плиз, код. Новый пример во вложении: отличие в последнем пункте.
Когда ваш код срабатывает на моем первоначальном примере, он меняет шрифт во всех последующих пунктах (Courier New), кроме первого (Times New Roman). Сделайте, если можно, чтобы все было таким же шрифтом как в примере, то есть - Times New Roman.

Благодарю.


Добавлено.
Первый пункт доработан самостоятельно.
Второй пункт тоже:
Option Explicit

Sub Sample()
Dim objParagraph As Paragraph
Dim boolStartNum As Boolean
Dim lngStartCharacter As Long
Dim lngEndCharacter As Long


boolStartNum = False

For Each objParagraph In ThisDocument.Content.Paragraphs
If StrComp(Trim(Replace(objParagraph.Range.Text, vbCr, "")), "Додатки:", vbTextCompare) = 0 Then
boolStartNum = True
lngStartCharacter = objParagraph.Range.Characters.Last.End
Else
If boolStartNum Then
If StrComp(Trim(Replace(objParagraph.Range.Text, vbCr, "")), "Копія довіреності на право підпису.", vbTextCompare) = 0 Then
boolStartNum = False
lngEndCharacter = objParagraph.Range.Characters.Last.End

With ThisDocument.Range(lngStartCharacter, lngEndCharacter).ListFormat
.RemoveNumbers NumberType:=wdNumberParagraph
.ApplyListTemplate _
ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1), _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList, _
DefaultListBehavior:=wdWord10ListBehavior
End With
End If
End If
End If
Next

ActiveDocument.Range.Font.Color = wdColorAutomatic
ActiveDocument.Range.Font.Name = "Times New Roman"
ActiveDocument.Range.Font.Size = 12
End Sub
Добавлено три строки, они выделены жирным в коде.