[решено] Поиск строки с № и вставка последующего номера в конце документа (Word)

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

Поиск строки с № и вставка последующего номера в конце документа (Word)

Приветствую! Столкнулся с такой проблемой: существует документ Word, куда заносятся определенные данные...
Каждые новые данные начинаются строкой № затем идет цифровой значение (оно может быть до 9999)
затем идет несколько строк (не регламентировано) с описанием (не содержащие "№")
после чего через пустую строку начинается новый №
Может это можно как-то автоматизировать
а то не сообразить как это сделать
а в программировании я не разбираюсь...
Заранее благодарен

sergey-pskov, Вам нужен макрос, который будет отслеживать последний номер и вставлять «его+1» по горячей клавише/кнопке на панели инструментов?

Если документ предназначен только для просмотра/печати (не для последующей машинной обработки) — достаточно соответствующего нумерованного стиля, в формате нумерации которого перед номером будет задан знак «№».

Вам нужен макрос, который будет отслеживать последний номер и вставлять «его+1» по горячей клавише/кнопке на панели инструментов?
Да! Мне нужен именно макрос... В моем случае "нумерованный список" не подходит...

sergey-pskov, цитирование осуществляется тэгом «quote».

Цитата:

Цитата sergey-pskov

Мне нужен именно макрос... В моем случае "нумерованный список" не подходит... »

Ясно. Тогда пробуйте так:

Код:

Option Explicit



Sub AddNextNumber()

    Const boolReNumberNext As Boolean = True

    

    Dim arrLines() As String

    Dim i As Long

    

    Dim lngNextNumber As Long

    Dim retValue As String

    

    Dim objParagraph As Paragraph

    Dim objRange As Range

    

    

    Selection.Collapse Direction:=wdCollapseStart



    arrLines = Split(ActiveDocument.Range(ActiveDocument.Range.Start, Selection.Range.Start).Text, vbCr)

    

    lngNextNumber = 0

    

    For i = UBound(arrLines) To LBound(arrLines) Step -1

        If Left(arrLines(i), 1) = "№" Then

            lngNextNumber = CLng(Mid(arrLines(i), 2))

            

            Exit For

        End If

    Next

    

    retValue = InputBox("Введите очередной номер:", "Очередной номер", lngNextNumber + 1)

    

    If retValue <> "" Then

        With Selection

            .InsertParagraph

            .InsertAfter "№" & retValue

            

            .Collapse Direction:=wdCollapseEnd

            .InsertParagraph

            

            .Collapse Direction:=wdCollapseEnd

        End With

        

        If boolReNumberNext Then ' Перенумеровать все нижеследующие номера

            lngNextNumber = CLng(retValue) + 1

            

            For Each objParagraph In ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Range.End).Paragraphs

                If objParagraph.Range.Characters.Item(1) = "№" Then

                    Set objRange = objParagraph.Range

                    

                    objRange.End = objRange.End - 1

                    objRange.Text = "№" & CStr(lngNextNumber)

                    

                    lngNextNumber = lngNextNumber + 1

                End If

            Next

        End If

    End If

End Sub

Прикреплён образец документа с данным макросом, внедрённой панелью инструментов и горячей клавишей.

Благодарю! Большое спасибо!