Файл был приложен для сравнения.
Часть кода
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 все расно при наличии таблицы работает, а при ее отсутствии - нет :(
Вышел из положения так
Здесь добавил две строки
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
Вроде работает :)
Чтобы вам помогли, вам нужно было выложить два файла:
в одном файле нет таблицы
во втором файле есть таблица
И словами описать, что нужно сделать (без упоминания программирования).
Из файла нужно удалять личные данные.
Выгружаемые файлы при наличии таблицы имеют пустую строку в конце документа, при отсутствии таблицы отсутствует и пустая строка.
После последней записи (будь то таблица или текст) должна быть одна (!) пустая строка или интервал 18 пт, затем вставка ФИО исполнителя, а на следующей строке - текущая дата.
[ФАЙЛЫ ВАШИ ПОЛУЧЕНЫ - НЕТ НЕОБХОДИМОСТИ ВЫКЛАДЫВАТЬ ИХ ПОВТОРНО]
Покажите ещё файлы, как должно быть.
Должно быть так
Я скачал только один файл, в котором таблица.
Выложите ещё раз второй файл, в котором нет таблицы (в том виде, как должно быть после макроса).
Как должно быть, если нет таблицы
Макрос
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