1

Тема: Добавление строк в таблицу согласно одинаковому количеству параграфов

Уныло как-то на форуме, одни смамеры «веселятся». Подкину «код на вентилятор», который добавляет строки в таблицу и переносит непустые параграфы в соответствии с их количеством. Обычная ситуация для двуязычного документа, несколько параграфов, а то и половина документа внесена в одну ячейку таблицы. Соответственно, перевод находится в соседней ячейке.  Задача: перенести параграф оригинала текста и перевода в отдельную строку. Проще говоря, в приложении подопытные файлы на которых можно воочию увидеть результат, применив макрос.
Хотелось бы от генералов VBA данного форума получить рекомендации как сделать код более понятней и проще, а другими словами поднабраться опыта.

' добавляем строки в таблицу согласно одинаковому количеству параграфов в ячейках строки
' осущетвлено AlexStar

Sub SplitTableRowOnCoutnOfParagraph()
Dim BackToRow, i, j, TableIndex, CurrentRowIndex, CheckCountOfPrg As Integer

Application.ScreenUpdating = False

On Error GoTo ErrorHandler
If Selection.Information(wdWithInTable) Then
 If Selection.Rows.Count = 1 Then  ' проверяем выделение одной строки таблицы
  i = 1
    ' ищем и удаляем пустые параграфы, табуляторы, разрыв строки в выделенной строке таблицы (все столбцы)' 32 пробел,
  With Selection
    While i < .Rows(1).Range.Paragraphs.Count
              .Rows(1).Range.Paragraphs(i).Range.Select
        
               
        Do While .Paragraphs(1).Range.Characters.First = Chr(32) Or .Paragraphs(1).Range.Characters.First = vbCr Or _
                 .Paragraphs(1).Range.Characters.First = vbTab Or .Paragraphs(1).Range.Characters.First = vbVerticalTab
                 j = Len(.Rows(1).Range.Paragraphs(i).Range.Text)
                 .Rows(1).Range.Paragraphs(i).Range.Select
                
                ' Удаление символов, защита от зацикливания при невозможности удаления символа (и такое бывает).
                .Paragraphs(1).Range.Characters.First.Delete
                If j = Len(.Rows(1).Range.Paragraphs(i).Range.Text) And j > 1 Then
                Exit Do
                End If
         Loop
        
       ' поднимаем символ конца ячейки на предыдущий параграф
       If Right(.Rows(1).Range.Paragraphs(i).Range.Text, 3) = Chr(13) & Chr(7) And .Cells(1).Range.Paragraphs.Count > 1 Then
          .Rows(1).Range.Paragraphs(i).Range.Characters.Last.Previous.Delete
          i = i - 1
       End If
      i = i + 1
     Wend
  End With
     
     If Selection.Cells(1).Range.Paragraphs.Count > 0 Then
     TableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count  'получаем индекс таблицы
     
     CurrentRowIndex = Selection.Rows(1).Index                                          ' запоминаем номер строки где находится редактируемый текст
     BackToRow = CurrentRowIndex
     i = 1
     j = ActiveDocument.Tables(TableIndex).Columns.Count ' количество столбцов в таблице
       
     ' сравниваем количество непустых параграфов в столбцах
     CheckCountOfPrg = ActiveDocument.Tables(TableIndex).Cell(CurrentRowIndex, j).Range.Paragraphs.Count
     For j = 1 To ActiveDocument.Tables(TableIndex).Columns.Count
            If CheckCountOfPrg <> ActiveDocument.Tables(TableIndex).Cell(CurrentRowIndex, j).Range.Paragraphs.Count Then
             MsgBox "Число непустых параграфов в столбцах разное." & vbCr & _
             "Для выполнения алгоритма, необходимо одинаковое количество непустых параграфов." & vbCr & _
             "Работа остановлена!", vbCritical
             Exit Sub
            End If
      Next j
      
   ' основная работа
       i = 1
       
       With ActiveDocument.Tables(TableIndex)
       j = .Columns.Count ' количество столбцов
             While i < Selection.Cells(1).Range.Paragraphs.Count
                For j = 1 To .Columns.Count
                    .Cell(CurrentRowIndex, j).Range.Paragraphs(1).Range.Select
                    .Cell(CurrentRowIndex, j).Range.Paragraphs(1).Range.Cut
                              
                    If j = 1 Then
                    Selection.InsertRowsAbove 1
                    Else
                    CurrentRowIndex = CurrentRowIndex - 1
                    End If
                                   
                    .Cell(CurrentRowIndex, j).Range.Paragraphs(1).Range.Paste
                    .Cell(CurrentRowIndex, j).Range.Paragraphs(2).Range.Characters.Last.Previous.Delete
                    CurrentRowIndex = CurrentRowIndex + 1
                 Next j
                
                If .Columns.Count = 1 Then
                CurrentRowIndex = Selection.Rows(1).Index + 1
                .Cell(CurrentRowIndex, 1).Select
                End If
            Wend
        End With
            
     End If
 Else
 MsgBox prompt:="Выделите только одну строку таблицы", Buttons:=vbOKOnly
 End If
ActiveDocument.Tables(TableIndex).Cell(BackToRow, 1).Select ' возврат на строку перед добавлением
End If

GoTo Ends:
ErrorHandler:
MsgBox prompt:="Непредвиденная ошибка, что то пошло не так, как задумано!", Title:="Ops...", Buttons:=vbOKOnly + vbCritical
Ends:

Application.ScreenUpdating = True
End Sub
Post's attachments

2Col.docx 21.48 Кб, 1 скачиваний с 2018-02-16 

You don't have the permssions to download the attachments of this post.
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

2

Re: Добавление строк в таблицу согласно одинаковому количеству параграфов

AlexStar пишет:

Хотелось бы от генералов VBA данного форума получить рекомендации как сделать код более понятней и проще, а другими словами поднабраться опыта.

Я напишу некоторые замечания к самому VBA-коду, может быть, что-то из этих советов поможет вам писать более понятный код.
1. Пишите отдельный оператор Dim на отдельную переменную. Вот вам, видимо, кажется, что  в вашем операторе все переменные объявлены как Integer. На самом деле - только последняя (а остальные будут с типом Variant). Кстати, когда каждая переменная объвлена отдельно, ее проще комментировать (надеюсь, вы не против указания комментариев в коде).
2. Не указывайте в операторах условий длинных выражений (напр., таких, как в вашем операторе Do While). Это затрудняет отладку. К тому же вы одно и то же выражение используете несколько раз, что приводит к необходимости каждый раз его вычислять.
Лучше присвойте некоторой переменной значение этого длинного выражения (и прокомментируйте это присвоение), а затем эту переменную далее используйте в условии. Заодно можно при исполнении всегда провести отладку путем останова на операторе условия и проверке значения этой переменной.
3. Перед кодом (до объявления переменных) пишите 3-5 строчек комментария, кратко описывающих цель программы и основные идеи алгоритма.
4. Я не любитель оператора Exit Sub. Вместо этого я иногда поступаю так: формирую в строке сообщения (изначально пустой) нужное значение и перехожу на метку конца программы. Там проверяю, пуста ли эта строка. Если нет, то выдаю сообщение со значением этой строки (или возвращаю это значение в функции или параметре, чтобы проанализировать в вызывающей программе).
5. Отступы в тексте программы нужно вести более единообразно. Не буду занудствовать, тут каждый склонен сам строить свои правила.
6. Еще маленькая придирка: лучше употреблять слово

3

Re: Добавление строк в таблицу согласно одинаковому количеству параграфов

1. Пишите отдельный оператор Dim на отдельную переменную.

Спасибо, приоткрыли глаза. Даже не догадывался о таком подвохе в VBA так как "воспитывался" на Паскале.

2. Не указывайте в операторах условий длинных выражений

В процессе написания и отладки всегда присутствуют промежуточные переменные. Не помню почему, но сложилось у меня мнение, что если можно обойтись без дополнительных переменных а использовать свойства экземпляра объекта напрямую то это упрощает алгоритм хотя не скажешь о его читаемости.  Так как это небольшая часть кода одного "проекта" в котором создавался класс, а процесс отладки при создании экземпляра класса, весьма занятное дело, то это такая шалость сделать лишних "два прихлопа, два подскока".
Можно вас попросить предложить реализацию данного фрагмента кода. Нагляднее всегда понято, потому, как в данном случае соглашусь chr(32). Остальное константы ведь?

3. Перед кодом (до объявления переменных) пишите 3-5 строчек комментария, кратко описывающих цель программы и основные идеи алгоритма.

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

4. Я не любитель оператора Exit Sub. Вместо этого я иногда поступаю так: формирую в строке сообщения (изначально пустой) нужное значение и перехожу на метку конца программы. Там проверяю, пуста ли эта строка. Если нет, то выдаю сообщение со значением этой строки (или возвращаю это значение в функции или параметре, чтобы проанализировать в вызывающей программе).

Обдумаю ваше замечание.

6. Еще маленькая придирка: лучше употреблять слово

Полагаю, было еще что то, как обычно, "съедено" движком сайта.
При много благодарен за советы.

"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

4

Re: Добавление строк в таблицу согласно одинаковому количеству параграфов

AlexStar пишет:

Можно вас попросить предложить реализацию данного фрагмента кода. Нагляднее всегда понято, потому, как в данном случае соглашусь chr(32). Остальное константы ведь?
. . .
Полагаю, было еще что то, как обычно, "съедено" движком сайта.

По поводу "длинных" выражений: вот пример упрощения (или усложнения - кому как). Удобно тем, что всегда в отладчике можно посмотреть переменную FC:

FC = .Paragraphs(1).Range.Characters.First
Do While (FC = Chr(32) Or FC = vbCr Or FC = vbTab Or FC = vbVerticalTab)
   . . .
   FC = .Paragraphs(1).Range.Characters.First
Loop

По поводу "съеденного" слова: хотел сказать, что слово "абзац" лучше, на мой взгляд (или ухо), звучит, чем слово "параграф".

5

Re: Добавление строк в таблицу согласно одинаковому количеству параграфов

Привет.

Интересная задача. Написал свое решение для строки. Сделал через Selection. Модуль с комментариями прикрепил.

Если форматрование абзацев разное, то вид будет не очень, из-за разной высоты абзацев. Думаю надо спрашивать пользователя, столько абзацев оставлять в шапке строки, так сказать smile

Думаю, нужен еще вариант макроса для разбивки одной яячеки.

Post's attachments

RowSplitByParagraph_Module.bas 4.73 Кб, 1 скачиваний с 2018-02-17 

You don't have the permssions to download the attachments of this post.
Макросы под заказ и готовый пакет - mtdmacro.ru

6

Re: Добавление строк в таблицу согласно одинаковому количеству параграфов

Спасибо вождям VBA за комментарии как к стилю программирования, так и к альтернативному решению данной задачи. Скорее всего, вариант 2 был реализован для идеальной таблицы. Представленный мной вариант был написан по мотивам «боевого» документа более чем из 70 страниц, но как обычно, невозможно учесть всевозможные «цирковые номера» которые артисты word могут реализовать в документе. Так, после опубликования на сайте кода, был получен документ, где пришлось доработать анализ и корректность данных.
В коде реализовано 4 этапа:
1. Проверяем выделенную строку таблицы на вхождение в нее: таблиц, фреймов, графических элементов. В случае нахождения покидаем процедуру с соответствующими пояснениями пользователю.
2. Находим и удаляем: пустые абзацы; абзацы с пробелами; знак табуляции.
3. Сравниваем количество полученных абзацев в каждом столбце. В случае несовпадения количества, покидаем процедуру с соответствующим комментарием.
4. Распределяем абзацы в дополнительные строки таблицы.

Хочу заметить, что задача решена для 1..N столбцов таблицы.
Пока не понято как реализовать случай если таблица имеет объединённые ячейки (а надо ли). В настоящий момент реализовано на обработчике ошибок и завершение процедуры в случае невозможности реализовать действия алгоритма.
В приложении, вы найдете код с внесенными изменения согласно пожеланиями вождей и генералов VBA данного форума.
Спасибо.

Post's attachments

mSubs.bas 5.89 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"