Таблица Word найти разрыв абзаца, разбить содержимое строки на две строки - PullRequest
Новая
       6

Таблица Word найти разрыв абзаца, разбить содержимое строки на две строки

0 голосов
/ 04 мая 2019

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

Мало строк в таблице, у которых разрыв изображения (¶) отмечен желтым цветом на изображении, и в той же строке несколько текстов с пробелом, выделенным зеленым цветом.

Я пытаюсь найти строки для разрыва абзаца. Если найдено, добавьте строку ниже и разбейте содержимое на две строки. Ниже изображения, объясните детали. В приведенных ниже таблицах представлены Включение меток форматирования.

Первый ряд с переменной шириной. Следовательно, найдите от строки 2 до последней строки, так как остальные строки похожи. Первые три столбца остаются постоянными.

Before

Expected

найдено подобное сообщение, но не разбито содержимое строки ( Таблица MS Word - макрокоманда, чтобы найти строку, содержащую определенный текст, а затем переместить всю строку на последнюю строку в таблице ). Я пытаюсь найти "^ p".

От 4 до последнего столбца с разрывом абзаца в любой строке. Новая строка добавляется после и дублирует содержимое вышеупомянутой строки, а затем разделяется. Столбцы с 1 по 3 имеют пробел между текстом.

Аналогичная запись Перемещение вниз по строке в таблице Word, содержащей ячейки из нескольких абзацев Но не работает в смешанной таблице ширины. 

Sub FindParagraph()
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = False
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then

'Don not know code.



End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End Sub

1 Ответ

1 голос
/ 06 мая 2019

Я сомневаюсь, что рекордер макросов здесь сильно поможет. Попробуйте: 

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long, bFnd As Boolean
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For r = .Rows.Count To 2 Step -1
      With .Rows(r).Range.Find
        .Text = " "
        .Replacement.Text = "^p"
        .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
Next
Application.ScreenUpdating = True
End Sub
...