Загрузка данных
Sub CreatePracticalWork4()
Dim doc1 As Document, doc2 As Document, doc3 As Document
Dim desktopPath As String
Dim i As Integer
' Путь к Рабочему столу
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
' ==========================================
' 1. СОЗДАНИЕ И НАСТРОЙКА ФАЙЛА "МАКЕТ 1"
' ==========================================
Set doc1 = Documents.Add
With doc1.PageSetup
.PaperSize = wdPaperA4
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(1.5)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2)
.RightMargin = CentimetersToPoints(1)
.OddAndEvenPagesHeaderFooter = True
End With
' Создаем 10 страниц: разрывы разделов после 4-й и 7-й страниц
For i = 1 To 9
If i = 4 Or i = 7 Then
Selection.InsertBreak Type:=wdSectionBreakNextPage
Else
Selection.InsertBreak Type:=wdPageBreak
End If
Next i
' Настройка 2-го раздела в Макет 1 (альбомная ориентация и поля)
With doc1.Sections(2).PageSetup
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(2)
.RightMargin = CentimetersToPoints(1.5)
End With
' Колонтитулы для Макет 1
doc1.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "Макет 1"
doc1.Sections(1).Footers(wdHeaderFooterEvenPages).Range.Text = vbTab & "Мельников"
doc1.SaveAs2 FileName:=desktopPath & "Макет 1.docx", FileFormat:=wdFormatXMLDocument
' ==========================================
' 2. СОЗДАНИЕ И НАСТРОЙКА ФАЙЛА "МАКЕТ 3"
' ==========================================
Set doc3 = Documents.Add
For i = 1 To 9
If i = 4 Or i = 7 Then
Selection.InsertBreak Type:=wdSectionBreakNextPage
Else
Selection.InsertBreak Type:=wdPageBreak
End If
Next i
For i = 1 To 3
With doc3.Sections(i).PageSetup
.PaperSize = wdPaperA4
.Orientation = wdOrientLandscape
.TwoPagesOnOne = True
.TopMargin = CentimetersToPoints(1.5)
.BottomMargin = CentimetersToPoints(1.5)
.LeftMargin = CentimetersToPoints(1) ' Внутри
.RightMargin = CentimetersToPoints(1.8) ' Снаружи
.Gutter = CentimetersToPoints(0.2) ' Переплет
End With
Next i
doc3.SaveAs2 FileName:=desktopPath & "Макет 3.docx", FileFormat:=wdFormatXMLDocument
doc3.Close
' ==========================================
' 3. СОЗДАНИЕ И НАСТРОЙКА ФАЙЛА "МАКЕТ 2"
' ==========================================
Set doc2 = Documents.Add
For i = 1 To 9
If i = 4 Or i = 7 Then
Selection.InsertBreak Type:=wdSectionBreakNextPage
Else
Selection.InsertBreak Type:=wdPageBreak
End If
Next i
For i = 1 To 3
With doc2.Sections(i).PageSetup
.PaperSize = wdPaperA4
.MirrorMargins = True
.TopMargin = CentimetersToPoints(1.5)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(1.5) ' Внутри
.RightMargin = CentimetersToPoints(3.5) ' Снаружи
.OddAndEvenPagesHeaderFooter = True
.DifferentFirstPageHeaderFooter = True
If i = 2 Then
.Orientation = wdOrientLandscape
Else
.Orientation = wdOrientPortrait
End If
End With
Next i
' Нижний колонтитул в Макет 2 (фамилия Мельников на всех типах страниц)
doc2.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text = "Мельников"
doc2.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Мельников"
doc2.Sections(1).Footers(wdHeaderFooterEvenPages).Range.Text = "Мельников"
' Верхние колонтитулы 1-го раздела
doc2.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = "Содержание главы 1"
doc2.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "Глава 1"
With doc2.Sections(1).Headers(wdHeaderFooterEvenPages).Range
.Text = "H"
.Font.Name = "Webdings"
End With
' Верхние колонтитулы 2-го раздела (отключаем "Как в предыдущем")
doc2.Sections(2).Headers(wdHeaderFooterFirstPage).LinkToPrevious = False
doc2.Sections(2).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
doc2.Sections(2).Headers(wdHeaderFooterEvenPages).LinkToPrevious = False
doc2.Sections(2).Headers(wdHeaderFooterFirstPage).Range.Text = "Содержание главы 2"
doc2.Sections(2).Headers(wdHeaderFooterPrimary).Range.Text = "Глава 2"
With doc2.Sections(2).Headers(wdHeaderFooterEvenPages).Range
.Text = "J"
.Font.Name = "Webdings"
End With
' Верхние колонтитулы 3-го раздела (отключаем "Как в предыдущем")
doc2.Sections(3).Headers(wdHeaderFooterFirstPage).LinkToPrevious = False
doc2.Sections(3).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
doc2.Sections(3).Headers(wdHeaderFooterEvenPages).LinkToPrevious = False
doc2.Sections(3).Headers(wdHeaderFooterFirstPage).Range.Text = "Содержание главы 3"
doc2.Sections(3).Headers(wdHeaderFooterPrimary).Range.Text = "Глава 3"
With doc2.Sections(3).Headers(wdHeaderFooterEvenPages).Range
.Text = "L"
.Font.Name = "Webdings"
End With
doc2.SaveAs2 FileName:=desktopPath & "Макет 2.docx", FileFormat:=wdFormatXMLDocument
MsgBox "Готово! Файлы Макет 1, Макет 2 и Макет 3 успешно созданы и сохранены на Рабочем столе.", vbInformation, "Практическая работа №4"
End Sub