Загрузка данных


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