Добавление интервала

[Посетитель 04.04.2024]

Файл был приложен для сравнения.

Часть кода
ActiveWindow.ActivePane.View.Type = wdPrintView
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:="Исп. Иванов И.И., 000-00-00" 'заменить на свои ФИО и телефон (в кавычках)
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy")

ведет себя странно. Если вторая таблица есть, то Selection.TypeParagraph выполняется и дополнительный отступ перед исполнителем появляется, а вот если таблицы нет, то и дополнительного отступа нет.
Попробовал добавить "Selection.ParagraphFormat.SpaceBefore = 18", но он тоже для файла с таблицей работает, для файла без таблицы - нет

Поправил код
ActiveWindow.ActivePane.View.Type = wdPrintView
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    With Selection.ParagraphFormat
        .SpaceBefore = 18
        .SpaceAfter = 0
        End With
    Selection.TypeText Text:="Исп. Иванов И.И., 000-00-00" 'заменить на свои ФИО и телефон (в кавычках)
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy") 'вставка текущей даты
    WordBasic.OpenOrCloseParaAbove
но Selection.TypeParagraph все расно при наличии таблицы работает, а при ее отсутствии - нет :(

[Посетитель 04.04.2024]

Вышел из положения так
Здесь добавил две строки
ActiveWindow.ActivePane.View.Type = wdPrintView
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.ParagraphFormat.SpaceBefore = 18
    Selection.TypeText Text:="Исп. Иванов И.И., 000-00-00" 'заменить на свои ФИО и телефон (в кавычках)
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy") 'вставка текущей даты
    WordBasic.OpenOrCloseParaAbove
и здесь добавил три строки
Dim Таблица As Table
    Dim i As Long
    If ActiveDocument.Tables.Count >= 2 Then
    Selection.MoveUp Count:=1
      Selection.HomeKey
      Selection.TypeBackspace
      Set Таблица = ActiveDocument.Tables(2)
      For i = Таблица.Rows.Count To 2 Step -1
          If Таблица.Cell(i, 4).Range.Text = Chr(13) & Chr(7) Then
          ElseIf Таблица.Cell(i, 4).Range.Text <> "Согласовано без замечаний " & Chr(13) & Chr(7) Then
                Таблица.Rows(i).Delete
               
          End If
      Next i
    End If

Вроде работает :)

[Администратор]

Чтобы вам помогли, вам нужно было выложить два файла:
в одном файле нет таблицы
во втором файле есть таблица

И словами описать, что нужно сделать (без упоминания программирования).
Из файла нужно удалять личные данные.

[Посетитель 04.04.2024]

Выгружаемые файлы при наличии таблицы имеют пустую строку в конце документа, при отсутствии таблицы отсутствует и пустая строка.
После последней записи (будь то таблица или текст) должна быть одна (!) пустая строка или интервал 18 пт, затем вставка ФИО исполнителя, а на следующей строке - текущая дата.

[ФАЙЛЫ ВАШИ ПОЛУЧЕНЫ - НЕТ НЕОБХОДИМОСТИ ВЫКЛАДЫВАТЬ ИХ ПОВТОРНО]

[Администратор]

Покажите ещё файлы, как должно быть.

[Посетитель 04.04.2024]

Должно быть так

[Администратор]

Я скачал только один файл, в котором таблица.
Выложите ещё раз второй файл, в котором нет таблицы (в том виде, как должно быть после макроса).

[Посетитель 04.04.2024]

Как должно быть, если нет таблицы

[Администратор]

Макрос

Sub ЛС()

    Dim Таблица As Table
    Dim i As Long
   
   
    ' Переход в режим "Разметка страницы".
    ActiveWindow.ActivePane.View.Type = wdPrintView
       
    ' Если в документе есть две и более таблицы.
    If ActiveDocument.Tables.Count >= 2 Then
       
        ' Вставка текста в конец документа.
        Selection.EndKey Unit:=wdStory
        Selection.ParagraphFormat.SpaceBefore = 18
        Selection.TypeText Text:="Исп. Иванов И.И., 000-00-00" 'заменить на свои ФИО и телефон (в кавычках)
        Selection.EndKey Unit:=wdStory
        Selection.TypeParagraph
        Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy") 'вставка текущей даты
        Selection.ParagraphFormat.SpaceBefore = 0
       
        ' Удаление строк в таблице по условиям.
        Set Таблица = ActiveDocument.Tables(2)
        For i = Таблица.Rows.Count To 2 Step -1
            If Таблица.Cell(i, 4).Range.Text = Chr(13) & Chr(7) Then
            ElseIf Таблица.Cell(i, 4).Range.Text <> "Согласовано без замечаний " & Chr(13) & Chr(7) Then
                Таблица.Rows(i).Delete
            End If
        Next i
   
    ' Если в документе нет двух и более таблиц.
    Else
        ' Вставка текста в конец документа.
        Selection.EndKey Unit:=wdStory
        Selection.TypeParagraph
        Selection.ParagraphFormat.SpaceBefore = 18
        Selection.TypeText Text:="Исп. Иванов И.И., 000-00-00" 'заменить на свои ФИО и телефон (в кавычках)
        Selection.EndKey Unit:=wdStory
        Selection.TypeParagraph
        Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy") 'вставка текущей даты
        Selection.ParagraphFormat.SpaceBefore = 0
    End If

End Sub

[свернуть]