---

Sub CreatePracticalWork4()
    Dim doc1 As Document, doc2 As Document, doc3 As Document
    Dim savePath As String
    Dim i As Integer
    Dim sMaket As String, sFam As String, sGlava As String, sSod As String
    
    ' Папка "Документы" по умолчанию в Word
    savePath = Options.DefaultFilePath(wdDocumentsPath)
    If Right(savePath, 1) <> "\" Then savePath = savePath & "\"
    
    ' Русские слова в кодах Unicode (чтобы не было знаков "???")
    ' "Макет "
    sMaket = ChrW(1052) & ChrW(1072) & ChrW(1082) & ChrW(1077) & ChrW(1090) & " "
    ' "Мельников"
    sFam = ChrW(1052) & ChrW(1077) & ChrW(1083) & ChrW(1100) & ChrW(1085) & ChrW(1080) & ChrW(1082) & ChrW(1086) & ChrW(1074)
    ' "Глава "
    sGlava = ChrW(1043) & ChrW(1083) & ChrW(1072) & ChrW(1074) & ChrW(1072) & " "
    ' "Содержание главы "
    sSod = ChrW(1057) & ChrW(1086) & ChrW(1076) & ChrW(1077) & ChrW(1088) & ChrW(1078) & ChrW(1072) & ChrW(1085) & ChrW(1080) & ChrW(1077) & " " & ChrW(1075) & ChrW(1083) & ChrW(1072) & ChrW(1074) & ChrW(1099) & " "
    
    ' ==========================================
    ' 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
    
    For i = 1 To 9
        If i = 4 Or i = 7 Then
            doc1.ActiveWindow.Selection.InsertBreak Type:=wdSectionBreakNextPage
        Else
            doc1.ActiveWindow.Selection.InsertBreak Type:=wdPageBreak
        End If
    Next i
    
    With doc1.Sections(2).PageSetup
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(2)
        .BottomMargin = CentimetersToPoints(1)
        .LeftMargin = CentimetersToPoints(2)
        .RightMargin = CentimetersToPoints(1.5)
    End With
    
    doc1.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = sMaket & "1"
    doc1.Sections(1).Footers(wdHeaderFooterEvenPages).Range.Text = vbTab & sFam
    
    On Error Resume Next
    doc1.SaveAs FileName:=savePath & sMaket & "1.docx"
    On Error GoTo 0
    
    ' ==========================================
    ' 2. СОЗДАНИЕ "МАКЕТ 3"
    ' ==========================================
    Set doc3 = Documents.Add
    For i = 1 To 9
        If i = 4 Or i = 7 Then
            doc3.ActiveWindow.Selection.InsertBreak Type:=wdSectionBreakNextPage
        Else
            doc3.ActiveWindow.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
    
    On Error Resume Next
    doc3.SaveAs FileName:=savePath & sMaket & "3.docx"
    On Error GoTo 0
    
    ' ==========================================
    ' 3. СОЗДАНИЕ "МАКЕТ 2"
    ' ==========================================
    Set doc2 = Documents.Add
    For i = 1 To 9
        If i = 4 Or i = 7 Then
            doc2.ActiveWindow.Selection.InsertBreak Type:=wdSectionBreakNextPage
        Else
            doc2.ActiveWindow.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
    
    doc2.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text = sFam
    doc2.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = sFam
    doc2.Sections(1).Footers(wdHeaderFooterEvenPages).Range.Text = sFam
    
    ' Раздел 1
    doc2.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = sSod & "1"
    doc2.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = sGlava & "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 = sSod & "2"
    doc2.Sections(2).Headers(wdHeaderFooterPrimary).Range.Text = sGlava & "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 = sSod & "3"
    doc2.Sections(3).Headers(wdHeaderFooterPrimary).Range.Text = sGlava & "3"
    With doc2.Sections(3).Headers(wdHeaderFooterEvenPages).Range
        .Text = "L"
        .Font.Name = "Webdings"
    End With
    
    On Error Resume Next
    doc2.SaveAs FileName:=savePath & sMaket & "2.docx"
    On Error GoTo 0
    
    MsgBox "OK! Saved in: " & savePath, vbInformation, "Done"
End Sub