Макрос для массового форматирования документов docx, находящихся в одной папке

paketnoe-formatirovanie.vb

Sub ПакетноеФорматирование()
'
' массовое форматирование документов, находящихся в одной папке
'
'
Dim myFile As String
Dim myDoc As Document
Dim path As String
Dim fDlg As FileDialog
Dim ext() As Variant
Dim i As Long
On Error Resume Next
'msoFileDialogFilePicker – позволяет пользователям выбрать один или более файлов.
'Пути к файлам, выбранным пользователям, сохраняются в коллекции элементов FileDialogSelectedItems
Set fDlg = Application.FileDialog(msoFileDialogFolderPicker)
'Выбираем папку с файлами для форматирования
With fDlg
   .Title = "Выберите папку, содержащую документы и нажмите ДА"
   .AllowMultiSelect = False
   .InitialView = msoFileDialogViewList
   If .Show <> -1 Then
      MsgBox "Отменено", , "Массовое форматирование"
      Exit Sub
   End If
   path = fDlg.SelectedItems.Item(1)
   If Right(path, 1) <> "\" Then path = path + "\"
End With
'Закрываем любые открытые документы
If Documents.Count > 0 Then
   Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
ext = Array("*.doc", "*.docx", "*.rtf") 'Заносим в массив типы расширений
For i = 0 To UBound(ext) 'Запускаем цикл обхода файлов с расширениями из массива
'Заносим в переменную полный путь к первому файлу в папке,
'имена следующих файлов будут получены в цикле функцией Dir$() без аргументов
myFile = Dir$(path & ext(i))
'Запускаем цикл обработки каждого файла в папке
While myFile <> ""
   'Открываем каждый файл без видимости для пользователя
   Set myDoc = Documents.Open(path & myFile, Visible:=False)
   'Изменяем форматирование каждого файла
    With myDoc
        With .Range
            With .ParagraphFormat
                ' .FirstLineIndent = CentimetersToPoints(1.25)
                .LeftIndent = CentimetersToPoints(0)
                .SpaceBeforeAuto = False
                .SpaceAfterAuto = False
                .SpaceBefore = 0
                .SpaceAfter = 0
                .LineSpacingRule = wdLineSpaceSingle
                .LineUnitBefore = 0
                .LineUnitAfter = 0
            End With
            With .Font
                .Color = wdColorBlack
                .Name = "Times New Roman"
                .Size = 11
            End With
            With .Tables(1)
                .Style = "Сетка таблицы"
                .PreferredWidthType = wdPreferredWidthPercent
                .PreferredWidth = 100
                .Rows.Alignment = wdAlignRowLeft
                .Rows.WrapAroundText = False
                .Rows.HeightRule = wdRowHeightAtLeast
                .Rows.Height = CentimetersToPoints(0.5)
            End With
        End With
        .Close SaveChanges:=wdSaveChanges
    End With
myFile = Dir$()   'получаем следующее имя файла из папки
Wend
Next i
Set fDlg = Nothing
Set myDoc = Nothing
End Sub