Загрузка данных
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