Удаление страниц с разрывами разделов и без разрывов разделов

[oleg4226]

Доброго дня всем !

В общем создал форму для удаления страниц в Word
Однако не могу корректно удалить страницы в диапазоне по условию:
а нужно именно так

1)Имеем диапазон страниц с TextBox1 до TextBox2 для удаления
2)Определяем количество разрывов страниц в диапазоне (например их будет 5)
3)Удаляем все до 1 разрыва страницы и сохраняем 1 разрыв страницы (применяется Макрос2 для удаления)
4)Далее после 1 разрыва страницы удаляем все содержимое и все разрывы 2,3,4,5 (применяется Макрос1 для удаления)

Код макроса

Sub ЗапускФормы()
UserForm1.Show 0
End Sub

Sub УдалениеСтраницНомера()'макрос в самой форме
Dim NumPages As Long
NumPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
'проверка на корректные номера страниц
If TextBox1.Value <> "" And TextBox2.Value <> "" And (TextBox1.Value > NumPages Or TextBox2.Value > NumPages) Then
MsgBox "Вы ввели некорректные номера страниц больше чем в документе !"
Exit Sub
End If
'проверка на заполнение номеров страниц
If TextBox1.Value = "" Or TextBox2.Value = "" Then
MsgBox "Вы не заполнили номера страниц !"
Exit Sub
End If
'Запрет на удаление первой страницы
If TextBox1.Value < 2 Or TextBox2.Value < 2 Then
MsgBox "Нельзя удалять первую страницу !"
Exit Sub
End If 
'проверка на правильную последовательность страниц
If TextBox1.Value > TextBox2.Value Then
MsgBox "Проверьте последовательность введения страниц ! Значение Поле 1 не должно быть выше значения Поле 2 ! "
Exit Sub
End If 

'предмет вопроса по условию наличия разрыва раздела
If TextBox1.Value < NumPages And TextBox2.Value < NumPages Then 'пока последний лист не трогаем 
'Перебор листов в цикле в диапазоне TextBox1.Value и TextBox2.Value для подсчета разрывов разделов
'Удаляем все до 1(первого) разрыва раздела - применяем Макрос2
'Выделяем все ПОСЛЕ первого разрыва раздела и удаляем все - применяем Макрос1
End If

Sub Макрос1 ()'удалить лист без разрыва раздела
Dim start_ As Long, end_ As Long, i As Long
'4. Запись в переменную начала начальной страницы.
    start_ = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:= i).Start
'5. Запись в переменную конца конечной страницы.
        ' Нужно в переменную записать начало следующей страницы после указанной конечной.
        ' Если конечная страница - это последняя страница, то запишем в переменную конец файла.
    If ActiveDocument.ComputeStatistics(wdStatisticPages) = i Then
        end_ = ActiveDocument.Range.End
    Else
        end_ = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:= i + 1).Start
    End If
   
    '6. Выделение и удаление указанных страниц.
    ActiveDocument.Range(start_, end_).Select
    Selection.Delete
End Sub

Sub Макрос2 () 'удалить лист c разрывом раздела
Dim start_ As Long, end_ As Long, i As Long
'4. Запись в переменную начала начальной страницы.
    start_ = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:= i).Start
'5. Запись в переменную конца конечной страницы.
        ' Нужно в переменную записать начало следующей страницы после указанной конечной.
        ' Если конечная страница - это последняя страница, то запишем в переменную конец файла.
    If ActiveDocument.ComputeStatistics(wdStatisticPages) = i Then
        end_ = ActiveDocument.Range.End
    Else
        end_ = ActiveDocument.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:= i + 1).Start
    End If
   
    '6. Выделение указанных страниц.
    ActiveDocument.Range(start_, end_).Select
    '7.Сжимаем выделение, если последний _
    или предпоследний символ это разрыв
    With Selection
    If Asc(.Characters.Last) = 12 Then
      .MoveLeft wdCharacter, 1, wdExtend
    End If
    If Asc(.Characters.Last.Previous.Text) = 12 Then
      .MoveLeft wdCharacter, 2, wdExtend
    End If
    End With
	'8.Удаляем 
    Selection.Delete
End Sub

Макрос1 и Макрос2 предполагают действия с конкретной страницей,
и действия с переменной i , где i - номер страницы в цикле
Можно ли в Word както этот цикл сделать ?

[Вождь]

Зачем эти заморочки или это такая задача? Удалите сразу всю область диапазона страниц и вставьте в это место разрыв страницы. Результат будет один в один, так как удаление разрыва страницы ни на что не влияет, в отличие от удаления разрыва раздела.

[oleg4226]

понял вас - да действительно вы правы но как именно в это место вставить разрыв раздела (в место удаления) - не знаю как определить это место после удаления
Допустим удалили страницы диапазона

Sub Удаление()
Dim nStart As Long, nEnd As Long
Application.ScreenUpdating = False
If TextBox1.Value <> "" And TextBox2.Value <> "" Then
  With Selection
    'Переход к началу первой страницы удаления
.GoTo wdGoToPage, wdGoToAbsolute, TextBox1.Value
    'Запоминаем положение
    nStart = .Start
    'Переход к началу следующей страницы после последней страницы удаления
    .GoTo wdGoToPage, wdGoToAbsolute, TextBox2.Value + 1
    'Запоминаем положение
    nEnd = .Start
    'Выделяем
    .SetRange nStart, nEnd
    'Удаляем
    .Delete
  End With
  
Else
Exit Sub
End If
Application.ScreenUpdating = True

End Sub

и как далее корректно вставить разрыв раздела в конец предыдущей страницы - перед первой на удаление ??

[Вождь]

Где-то так:

Option Explicit

Sub Test()
    PAGES_GetRange(ActiveDocument, 2, 3).Select
    Selection.Delete
    Selection.InsertBreak Type:=wdSectionBreakNextPage
End Sub


' возвращает область документа Doc, от начала страницы StartPageNo до конца страницы EndPageNo
Function PAGES_GetRange(ByRef Doc As Document, ByVal StartPageNo As Long, Optional ByVal EndPageNo As Long) As Range
    ' готовим документ
    DoEvents
    Doc.ActiveWindow.ActivePane.View.Type = wdPrintView
    Doc.Repaginate
    ' страниц в документе
Dim N As Long
    N = Doc.Range.ComputeStatistics(wdStatisticPages)
    ' проверяем параметры
    If (StartPageNo < 1) Or (StartPageNo > N) Then Exit Function
    If (EndPageNo <= 0) Or (EndPageNo > N) Then
        EndPageNo = N
    ElseIf EndPageNo < StartPageNo Then
        Exit Function
    End If
    ' область страниц
Dim R As Range
    Set R = Doc.Range.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=StartPageNo)
    If EndPageNo >= N Then
        R.End = Doc.Range.StoryLength
    Else
        R.End = Doc.Range.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=EndPageNo + 1).Start
    End If
    ' результат
    Set PAGES_GetRange = R
End Function

[oleg4226]

ничего не понимаю в вашем макросе - это все новое для меня - буду изучать еще и функция непонятная - это вообще темный лес.))
это высший пилотаж - мне далеко до этого

Строчку
PAGES_GetRange(ActiveDocument, 2, 3).Select

заменить на
PAGES_GetRange(ActiveDocument, TextBox1.Value, TextBox2.Value).Select

так понимаю ?

и строка
Selection.InsertBreak Type:=wdSectionBreakNextPage определяет вставку разрыва раздела в предыдущую страницу

а если там текстом запполнено и разрыв не вставится и перейдет на следующую страницу ?

по моему алгоритму - пробовал руками сначала аккуратно удалять - все проходит нормально - но сложно получается

благодарю за помощь и заранее извиняюсь за глупые вопросы - я чайник в VBA только на примерах из инета учусь ))
попробую - отпишусь

[oleg4226]

нет не катит - создает новую страницу с разделом после предыдущей - а это не надо щас пример сделаю с вашим макросом

[oleg4226]

когда удаление происходит - по логике вашей - надо убивать сначала разрыв предыдущего раздела - потом удалять - а потом добаввлять разрыв

[oleg4226]

в общем пример с вашим внедренным макросом добавил
там смещение разделов происходит и разрыв попадает не туда

[oleg4226]

в общем по моей логике
1)убить диапазон до начала 1 разрыва
2)сохранить разрыв и далее начать удаление с конца разрыва
3)убить все до последней страницы диапазона (если последняя страница диапазона имеет разрыв - и его убить)

корректно проходит когда руками делаешь

[Вождь]

Похоже, вы всю тему путаете элементы "разрыв раздела" и "разрыв страницы". Я же сразу намекнул, что разрыв раздела - это совсем другой коленкор. Лучше всегда прикладывать пример документа - и вам писать меньше, и нам догадываться не нужно.