Разбить ячейку таблицы поабзацно...

RIKITIKI

Топикстартер
20 лет на форуме
Сообщения
1 465
Реакции
515
Добрый день!
Имеется таблица. В некоторых строках которой не один абзац, а скажем четыре. То есть в каждой ячейке такой строки по четыре абзаца. Есть ли какой-то макрос для разбивки таких строк поабзацно? 222.jpg
 

Linxy

Девушка с битой
10 лет на форуме
Сообщения
2 277
Реакции
3 836
  • Спасибо
Реакции: izrukvruki и RIKITIKI

RIKITIKI

Топикстартер
20 лет на форуме
Сообщения
1 465
Реакции
515
Да, я пользуюсь... только утомительно в каждой ячейке запускать....
Хотелось найти решение в Ворде и для всего файла сразу :(
 

Linxy

Девушка с битой
10 лет на форуме
Сообщения
2 277
Реакции
3 836
Вот тут товарищи похожий макрос сочинили
 
  • Спасибо
Реакции: RIKITIKI, Gad и izrukvruki

Gad

Сообщения
2 971
Реакции
1 405
Последнее редактирование:
  • Спасибо
Реакции: imma

imma

15 лет на форуме
Сообщения
3 089
Реакции
2 185
Копируем таблицу из Word, помещаем в Excel, копируем из Excel, помещаем в InD.
 
  • Спасибо
Реакции: Gad

Gad

Сообщения
2 971
Реакции
1 405
Хотелось найти решение в Ворде и для всего файла сразу
С подачи @Linxy
Код:
Sub ParagraphRow()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long, bFnd As Boolean
1:
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For r = .Rows.Count To 1 Step -1
      With .Rows(r).Range.Find
        .Text = " "
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
        .Text = "^p"
        .Execute
        bFnd = .Found
        End With
      If bFnd = True Then
        .Rows.Add .Rows(r)
        For c = 1 To .Columns.Count
          If .Cell(r + 1, c).Range.Paragraphs.Count > 1 Then
            .Cell(r, c).Range.Text = Split(.Cell(r + 1, c).Range.Text, vbCr)(0)
            .Cell(r + 1, c).Range.Paragraphs(1).Range.Text = vbNullString
          End If
        Next
      End If
    Next
    'End With
  End With
Next
If bFnd = True Then GoTo 1
Application.ScreenUpdating = True
End Sub
 
  • Спасибо
Реакции: lev и RIKITIKI

Gad

Сообщения
2 971
Реакции
1 405
Гм.... что-то он все пробелы убирает в тексте....
Да блин, уже попросил @Linxy заменить на верный вариант :) Но она пока не заходила :)
Эти 2 строки можно просто убрать если что :)
Код:
.Text = " "
.Replacement.Text = ""
 
Последнее редактирование:
  • Спасибо
Реакции: RIKITIKI

RIKITIKI

Топикстартер
20 лет на форуме
Сообщения
1 465
Реакции
515
блин... красота же :)
А я трахался скриптом от Eugenius (спасибо ему конечно) :)
 

Linxy

Девушка с битой
10 лет на форуме
Сообщения
2 277
Реакции
3 836
Да блин, уже попросил @Linxy заменить на верный вариант :)
Дима, я пока с телефона и редактировать очень неудобно. Можешь просто запостить рабочий итоговый вариант новым сообщением?
 

lev

Модератор
20 лет на форуме
Сообщения
2 142
Реакции
2 066
a.png

Не понравилось как макрос работает на ячейках с разным кол-вом строк (хоть у ТС такие и отсутствуют по условию. И GoTo меня несколько удивил. В общем написал свой вариант.
Код:
Sub ParaTabSplitter()
  For Each t In ActiveDocument.Tables
    For Each R In t.Rows
      rr = 1
      For Each cl In R.Cells
        tmp = cl.Range.Paragraphs.Count
        If rr < tmp Then rr = tmp
      Next cl
      If rr > 1 Then
        For Each cl In R.Cells
          txts = Split(cl.Range.Text, vbCr)
          cl.Split rr
          For i = 1 To UBound(txts)
            cl.Column.Cells(i).Range.Text = txts(i - 1)
          Next i
        Next cl
      End If
    Next R
  Next t
End Sub
 

lev

Модератор
20 лет на форуме
Сообщения
2 142
Реакции
2 066
b.png

Это при комбинированных ячейках (ваша ошибка при горизонтальном объединении). Ни мой макрос ни @Gad 'а данную ситуацию не обрабатывает. Во избежание остановки работы, можно добавить On Error Resume Next в первую строку макроса.
 

RIKITIKI

Топикстартер
20 лет на форуме
Сообщения
1 465
Реакции
515
при комбинированных ячейках
там нет комбинированных... да и спотыкается на первой же строке...
65432.jpg

если добавляю строку On Error Resume Next - создаёт пустые ячейки, но текст туда не переносит
и ячеек больше чем необходимо
54321.jpg
 

lev

Модератор
20 лет на форуме
Сообщения
2 142
Реакции
2 066
там нет комбинированных...
Чуток загорожено, но не наблюдаю 3-х колонок в самой первой строке "- N -", имхо, там второй и третий столбец скомбинированы.
если добавляю строку On Error Resume Next - создаёт пустые ячейки
Код:
Sub ParaTabSplitter()
  Dim r As Row, cl As Cell, t As Table
  On Error Resume Next
  For Each t In ActiveDocument.Tables
    For Each r In t.Rows
      rr = 1
      For Each cl In r.Cells
        tmp = cl.Range.Paragraphs.Count
        If rr < tmp Then rr = tmp
      Next cl
      If rr > 1 Then
        r.Cells.Split rr
        For Each cl In r.Cells
          txts = Split(cl.Range.Text, vbCr)
          For i = 0 To UBound(txts) - 1
            t.Cell(r.Index + i, cl.ColumnIndex).Range.Text = txts(i)
          Next i
        Next cl
      End If
    Next r
  Next t
End Sub
Новый вариант
 
Последнее редактирование:
  • Спасибо
Реакции: RIKITIKI и Gad