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

[sergey-pskov]

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

[Iska]

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

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

[sergey-pskov]

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

[Iska]

sergey-pskov, цитирование осуществляется тэгом «quote» (http://forum.oszone.net/misc.php?do=bbcode#quote).

Мне нужен именно макрос... В моем случае "нумерованный список" не подходит... »
Ясно. Тогда пробуйте так:
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

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

[sergey-pskov]

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