1

Тема: Макрос для замены всех разрывов раздела

Здравствуйте.
В документе около 500 страниц. Каждая страница заканчивается разрывом раздела. Вы не могли бы подсказать макрос для замены разрывов раздела на другой знак (например, на знак абзаца) во всем файле?

Пробовал с помощью

2

Re: Макрос для замены всех разрывов раздела

Почему-то предыдущее сообщение отображается не полностью.

...
Пробовал с помощью "Найти и заменить" (^b заменить на ^p), но почему-то заменяются не все разрывы раздела (именно разрывы раздела, а не разрывы страницы). Некоторые разрывы раздела остаются. При этом если я ищу вручную разрывы раздела (нажимаю "найти далее" в окне "найти и заменить", то очередной разрыв раздел отыскивается, но когда нажимаю на кнопку "заменить", разрыв раздела остаётся)

Заранее спасибо!

3

Re: Макрос для замены всех разрывов раздела

genmon пишет:

Почему-то предыдущее сообщение отображается не полностью.

...
Пробовал с помощью

4

Re: Макрос для замены всех разрывов раздела

возможно это разрыв на текущей странице(например при колонках на листе)

5

Re: Макрос для замены всех разрывов раздела

Новую тему не стал создавать, ибо проблема почти такая же...
Слияние идёт их экселя в ворд в поля, расположенные в ячейках таблицы.
Как великому неудобству, каждая таблица создаётся на новой странице. И под каждой таблицей располагается:

=====Разрыв раздела (со следующей страницы)=====

(см. файлы примера в прицепе. В файле 4 страницы, по таблице на каждой странице; разрывов раздела, соответственно, всего три: между 1/2, 2/3, 3/4 страницами).
Как автоматизировать удаление разрыва раздела?
--------------------
После замены ^b удаляется только разрыв 3/4. И то - на самом деле остаётся, но только как бы зажимается между 3 и 4 таблицами.

Post's attachments

1. С разрывом раздела.docx 24.41 Кб, 1 скачиваний с 2019-07-03 

You don't have the permssions to download the attachments of this post.

6

Re: Макрос для замены всех разрывов раздела

azur пишет:

. . .
После замены ^b удаляется только разрыв 3/4. И то - на самом деле остаётся, но только как бы зажимается между 3 и 4 таблицами.
. . .

В вашем документе в конце таблиц какой-то разделительный символ, по нажатии на который клавишей <Del> соседние таблицы объединяются. Вот с помощью этого макроса я в конце каждой таблицы убираю этот символ, а затем вставляю разрыв столбца:

Sub DelEndOfTableChars()
Dim tbl As Table
Dim itbl As Long
Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst
On Error Resume Next
For itbl = ActiveDocument.Tables.count To 1 Step -1
    Set tbl = ActiveDocument.Tables(itbl)
    tbl.Range.Select
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.Delete Unit:=wdCharacter, count:=1
    Selection.InsertBreak Type:=wdColumnBreak
Next itbl
On Error GoTo 0
End Sub

Попробуйте.

7

Re: Макрос для замены всех разрывов раздела

Спасибо! Работает  smile ...
==========

8

Re: Макрос для замены всех разрывов раздела

"какой-то разделительный символ" - вот он и генерируется (видимо) во время слияния и указан как Разрыв раздела...  hmm

Я для других целей делал другой документ, тоже с шаблоном слияния. И из-за этого какого-то_символа пришлось делать шаблон без таблицы.
Разрывы раздела генерировались, НО все эти разрывы без проблем удалялись через "Найти ^b и заменить". А вот если присутствует таблица в шаблоне слияния, то находится и удаляется только последний разрыв в файле результата слияния.  sad
--------------
Мммм.... Можете подсобить с удалением всех пустых строк в таблицах? Т.е. во всех таблицах документа найти полностью пустые строки и удалить их.  /// Или это уже другая тема? roll

9

Re: Макрос для замены всех разрывов раздела

azur пишет:

. . .
Мммм.... Можете подсобить с удалением всех пустых строк в таблицах? Т.е. во всех таблицах документа найти полностью пустые строки и удалить их.  /// Или это уже другая тема? roll
. . .

Наверное, другая тема. В ваших таблицах есть объединенные ячейки, поэтому Word не разрешает в подобных таблицах доступ к отдельным строкам как объектам (напр., с целью удаления). Если бы таблица была консистентной, то удаление строк целиком было бы возможным.
Нет времени возиться с такой таблицей. Это может выглядеть, напр., так: перебирать все ячейки таблицы, определяя номер строки и столбца (через vbInformation). Затем в цикле следить, произошла ли смена строки и заодно содержали ли все ли ячейки последней строки какие-то данные. Если таким образом выясняется, что строка была пустой, то попытаться  по ячейкам, начиная с первой ячейки строки, удалить эту строку. Правда, при этом можно нарваться на многочисленные риски с получением кривой таблицы.
Можно попытаться применить и какой-то другой подход.

10

Re: Макрос для замены всех разрывов раздела

Спасибо!...(( Мда....
На просторах нашёл макрос:

Sub DelEndOfTableChars()
Dim tbl As Table
Dim itbl As Long
Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst
On Error Resume Next
For itbl = ActiveDocument.Tables.count To 1 Step -1
    Set tbl = ActiveDocument.Tables(itbl)
    tbl.Range.Select
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.Delete Unit:=wdCharacter, count:=1
    Selection.InsertBreak Type:=wdColumnBreak
Next itbl
On Error GoTo 0

End Sub

...но он (в моём документе) удаляет пустые строки, которые пустые не полностью, а начиная со 2 столбца (а такие строки нужны). Можно что-то подкрутить, чтобы удалял только полностью пустые?

11

Re: Макрос для замены всех разрывов раздела

Стоп!  Не тот модуль скопировал.. Это ваш код  smile
Вот правильный:

Sub macros_del_rows()
Dim w(6)
 
For i = 1 To Word.ActiveDocument.Tables.Count
  With ActiveDocument.Tables(i)
    ' save widths
    For k = 1 To 6
     w(k) = .Columns(k).Width
    Next k
    For j = .Rows.Count To 1 Step -1
      If .Cell(j, 2).Range.Text = Chr(13) & Chr(7) Then
      .Rows(j).Delete
      End If
    Next j
    ' return widths
    For k = 1 To 6
     .Columns(k).Width = w(k)
    Next k
    End With
Next i
 
End Sub

12

Re: Макрос для замены всех разрывов раздела

azur пишет:

Стоп!  Не тот модуль скопировал.. Это ваш код  smile
Вот правильный:

Sub macros_del_rows()
Dim w(6)
 
For i = 1 To Word.ActiveDocument.Tables.Count
  With ActiveDocument.Tables(i)
    ' save widths
    For k = 1 To 6
     w(k) = .Columns(k).Width
    Next k
    For j = .Rows.Count To 1 Step -1
      If .Cell(j, 2).Range.Text = Chr(13) & Chr(7) Then
      .Rows(j).Delete
      End If
    Next j
    ' return widths
    For k = 1 To 6
     .Columns(k).Width = w(k)
    Next k
    End With
Next i
 
End Sub

Я уже вам отвечал, что у вас таблицы с объединенными ячейками, поэтому операции вроде

.Rows(j).Delete

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

13

Re: Макрос для замены всех разрывов раздела

yshindin пишет:

. . .
Я уже вам отвечал, что у вас таблицы с объединенными ячейками, поэтому операции вроде

.Rows(j).Delete

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

Поэтому можно пробовать удалять строки не через объекты Table.Row, а использовать Selection.Rows. Например, так:

Sub DeleteEmptyRowsInTables()
Dim i As Long
Dim tbl As Table
Dim j As Long
Dim cl As Cell
Dim clt As String
Dim remp as Boolean
 
For i = 1 To ActiveDocument.Tables.count
    Set tbl = ActiveDocument.Tables(i)
    With tbl
        ccl = .Columns.count
        For j = .Rows.count To 1 Step -1
            remp = True
            For icl = 1 To ccl
                Set cl = Nothing
                On Error Resume Next
                Set cl = .Cell(j, icl)
                On Error GoTo 0
                If cl Is Nothing Then
                    remp = False
                Else
                    clt = cl.Range.Text
                    clt = Replace(clt, Chr$(13), "")
                    clt = Replace(clt, Chr$(7), "")
                    clt = Trim(clt)
                    If clt <> "" Then
                        remp = False
                    End If
                End If
            Next icl
            If remp Then
                .Cell(j, 1).Select
                Selection.Collapse Direction:=wdCollapseStart
                Selection.MoveRight Unit:=wdCharacter, count:=ccl + 1, Extend:=wdExtend
                Selection.Rows.Delete
            End If
        Next j
    End With
Next i
 
End Sub