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

Gad

Сообщения
2 975
Реакции
1 408
Для разнообразия :) Результат одинаков :)
Код:
Sub ParagraphToRow()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long, bFnd As Boolean
For Each Tbl In ActiveDocument.Tables
  With Tbl
  r = 1
  rc = .Rows.Count
    Do While r < rc
      With .Rows(r).Range.Find
        .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
       r = r + 1
       rc = .Rows.Count + 1
     Loop
  End With
Next
Application.ScreenUpdating = True
End Sub
 
  • Спасибо
Реакции: RIKITIKI

RIKITIKI

Топикстартер
20 лет на форуме
Сообщения
1 471
Реакции
522
Ну да.... оба варианта рабочие. Пока никаких сбоев на нескольких файлах :)
Господа, вы просто супер!