Форум по VBA и MS Office

Sub ЛС()
    ActiveWindow.ActivePane.View.Type = wdPrintView
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.ParagraphFormat.SpaceBefore = 18
    Selection.TypeText Text:="Исп. Скаридов В.В., 7-42-64"
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy")
    WordBasic.OpenOrCloseParaAbove'для удаления интервала 18 пт у вставленной даты
   
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    Selection.Font.Size = 14
    Selection.Font.Color = wdColorAutomatic
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.Font.Name = "Times New Roman"
    Selection.EndKey Unit:=wdStory
   
    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
     
    'Сохранение файла в формате "ЛС сформирован ДД.ММ.ГГГГ в ЧЧ.ММ"
           
    Dim Fn As String
     
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Сохранить как"
        .InitialFileName = "D:\Документы\ЛС сформирован " & Format(Date, "DD.MM.YYYY") & " в " & Format(Time, "HH.MM")
        If .Show = False Then 'вот тут открывается окно сохранения файла с присвоением имени, но файл не сохраняется
            Exit Sub
        End If
        Fn = .SelectedItems(1)
    End With
   End Sub