Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)
-   -   [решено] Нумерация каждого списка в документе заново (http://forum.oszone.net/showthread.php?t=339314)

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

Iska 19-02-2019 20:30 2858839
Раньше было так — назначил потребный список (лучше всего — отдельным стилем), затем в нужном месте ПКМ по абзацу, «Начать заново»:
Скрытый текст

Как в Office 2010 — не знаю, не пробовал.

Казбек 19-02-2019 20:33 2858840
Iska,

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

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

Iska 19-02-2019 20:56 2858845
Казбек, а как Word или макрос определит, что есть список, где его начало и где конец? Таковой алгоритм либо должны определить Вы (для макроса), либо передоверить сие Word'у, воспользовшись автоформатированием — \Формат\Автоформат…:
Скрытый текст

убрав все флажки, кроме потребного, со вкладки Автоформат диалогового окна Автозамена, доступного из вышеуказанного диалогового окна по кнопке Параметры…:
Скрытый текст

P.S. Примеры, опять же, для версии Microsoft Office 2003.

Казбек 19-02-2019 21:06 2858849
Цитата:
Цитата Iska
а как Word или макрос определит, что есть список, где его начало и где конец? »
Цитата:
Цитата Казбек
Добавлено.
Еще один нюанс, возможно, это поможет реализовать затею. Текст перед списками всегда одинаковый, как и сами списки. »

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

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

Казбек 19-02-2019 21:37 2858864
Цитата:
Цитата Iska
Попробуйте Автоформат. Если не выйдет — пишите, будем думать над макросом. »
К сожалению, вообще ничего не произошло.

Iska 19-02-2019 21:55 2858876
Тогда думайте над алгоритмом и излагайте, мне — образец документа с несколькими реальными примерами списков в архиве.

Казбек 19-02-2019 22:14 2858883
Вложений: 1
Iska,

Структура документа примерно следующая, то есть, весь документ абсолютно цикличен, как в образце. Похожая тема есть здесь. Возможно, вам чем-то это поможет.

Цитата:
Цитата Iska
Тогда думайте над алгоритмом и излагайте »
Что-то типа этого. Согласны?
То есть, я убираю изначально все списки, а потом мы начинаем нумерацию всего, что после слова "додатки" и заканчиваем этот список после слова "довіреності". И так делаем циклично, годиться?

Iska 19-02-2019 23:14 2858902
Казбек, попробуйте вставить в модуль «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

Казбек 19-02-2019 23:28 2858908
Цитата:
Цитата Iska
попробуйте вставить в модуль «ThisDocument» искомого документа и выполнить следующий код макроса »
Прошу прощения, не совсем ясно, что я должен проделать... Можете более подробно описать эту процедуру, особенно, что касается текста "ThisDocument". Спасибо.

Iska 19-02-2019 23:42 2858912
Открыть искомый документ. Нажать Alt-F11, открыв Редактор VBA. Найти в окне Project Explorer (если этого окна не видно — нажать Ctrl-R) проект искомого документа, раскрыть его (если потребно), развернуть до модуля ThisDocument, щёлкнуть по последнему правой кнопкой мышки, в появившемся контекстном меню выбрать View Code (или просто выделить модуль и нажать F7):
Скрытый текст

В открывшееся окно вставить скопированный код со страницы конференции. Теперь можно выполнить код этого макроса (проще всего установить курсор где-нибудь внутри процедуры и нажать F5). Сам код впоследствии, после отработки, можно просто удалить.

Казбек 21-02-2019 21:12 2859275
Вложений: 1
Iska,

Почти превосходно. Два момента:
  1. Подлатайте, плиз, код. Новый пример во вложении: отличие в последнем пункте.
  2. Когда ваш код срабатывает на моем первоначальном примере, он меняет шрифт во всех последующих пунктах (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
Добавлено три строки, они выделены жирным в коде.


Время: 23:18.

Время: 23:18.
© OSzone.net 2001-