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


Sub CreateLab6()
    Dim doc As Document
    Dim rng As Range
    Dim tbl As Table
    Dim shp As Shape
    Dim ils As InlineShape
    Dim cht As Chart
    Dim wb As Object
    Dim ws As Object
    Dim sec As Section
    Dim i As Integer
    
    ' Создаём новый документ
    Set doc = Documents.Add
    
    ' 1. Поля страницы по ГОСТ (левое 3 см, правое 1.5 см, верхнее 2 см, нижнее 2 см)
    With doc.PageSetup
        .LeftMargin = CentimetersToPoints(3)
        .RightMargin = CentimetersToPoints(1.5)
        .TopMargin = CentimetersToPoints(2)
        .BottomMargin = CentimetersToPoints(2)
    End With
    
    ' Настройка основного стиля (Times New Roman, 14 пт, 1.5 интервал, отступ 1.25 см)
    With doc.Styles(wdStyleNormal)
        .Font.Name = "Times New Roman"
        .Font.Size = 14
        .Font.Color = wdColorBlack
        .ParagraphFormat.Alignment = wdAlignParagraphJustify
        .ParagraphFormat.FirstLineIndent = CentimetersToPoints(1.25)
        .ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
        .ParagraphFormat.SpaceBefore = 0
        .ParagraphFormat.SpaceAfter = 0
    End With
    
    ' Настройка Заголовка 1 по ГОСТ (по центру, 14 пт, полужирный, чёрный)
    With doc.Styles(wdStyleHeading1)
        .Font.Name = "Times New Roman"
        .Font.Size = 14
        .Font.Bold = True
        .Font.Color = wdColorBlack
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .ParagraphFormat.FirstLineIndent = 0
        .ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
        .ParagraphFormat.SpaceBefore = 0
        .ParagraphFormat.SpaceAfter = 12
    End With
    
    ' Настройка Заголовка 2 по ГОСТ
    With doc.Styles(wdStyleHeading2)
        .Font.Name = "Times New Roman"
        .Font.Size = 14
        .Font.Bold = True
        .Font.Color = wdColorBlack
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .ParagraphFormat.FirstLineIndent = 0
        .ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
        .ParagraphFormat.SpaceBefore = 6
        .ParagraphFormat.SpaceAfter = 6
    End With
    
    ' ================= СТРАНИЦА 1: МЕСТО ПОД АВТООГЛАВЛЕНИЕ =================
    Selection.Style = doc.Styles(wdStyleNormal)
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.ParagraphFormat.FirstLineIndent = 0
    Selection.Font.Bold = True
    Selection.TypeText "Оглавление"
    Selection.TypeParagraph
    Selection.Font.Bold = False
    
    ' Запоминаем место для вставки оглавления
    Dim tocRange As Range
    Set tocRange = Selection.Range
    Selection.TypeParagraph
    
    ' Переход на 2-ю страницу (п. 1.1 и 1.2)
    Selection.InsertBreak Type:=wdPageBreak
    
    ' ================= СТРАНИЦА 2: КВАНТОВЫЙ КОМПЬЮТЕР =================
    Selection.Style = doc.Styles(wdStyleHeading1)
    Selection.TypeText "Квантовый компьютер"
    Selection.TypeParagraph
    
    Selection.Style = doc.Styles(wdStyleNormal)
    Selection.TypeText "Вычислительное устройство, которое использует явления квантовой суперпозиции и квантовой запутанности для передачи и обработки данных. Квантовый компьютер (в отличие от обычного) оперирует не битами (способными принимать значение либо 0, либо 1), а кубитами, имеющими значения одновременно и 0, и 1. В результате можно обрабатывать все возможные состояния одновременно, достигая гигантского превосходства над обычными компьютерами в ряде алгоритмов."
    Selection.TypeParagraph
    
    Selection.TypeText "Полноценный универсальный квантовый компьютер является пока гипотетическим устройством, сама возможность построения которого связана с серьёзным развитием квантовой теории в области многих частиц и сложных экспериментов; разработки в данной области связаны с новейшими открытиями и достижениями современной физики. На середину 2010-х были практически реализованы лишь единичные экспериментальные системы, исполняющие фиксированный алгоритм небольшой сложности. Пример квантового компьютера указан на рисунке 1."
    Selection.TypeParagraph
    
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.ParagraphFormat.FirstLineIndent = 0
    Selection.TypeText "[Вставьте сюда картинку квантового компьютера из задания]"
    Selection.TypeParagraph
    Selection.TypeText "Рисунок 1 — Квантовый компьютер"
    Selection.TypeParagraph
    
    ' Переход на 3-ю страницу
    Selection.InsertBreak Type:=wdPageBreak
    
    ' ================= СТРАНИЦА 3: ИСКУССТВЕННАЯ НЕЙРОННАЯ СЕТЬ =================
    Selection.Style = doc.Styles(wdStyleHeading1)
    Selection.TypeText "Искусственная нейронная сеть"
    Selection.TypeParagraph
    
    Selection.Style = doc.Styles(wdStyleNormal)
    Selection.TypeText "(ИНС) — математическая модель, а также её программное или аппаратное воплощение, построенная по принципу организации и функционирования биологических нейронных сетей — сетей нервных клеток живого организма. Это понятие возникло при изучении процессов, протекающих в мозге, и при попытке смоделировать эти процессы. Первой такой попыткой были нейронные сети У. Маккалока и У. Питтса. После разработки алгоритмов обучения получаемые модели стали использовать в практических целях: в задачах прогнозирования, для распознавания образов, в задачах управления и др."
    Selection.TypeParagraph
    
    ' Переход на 4-ю страницу
    Selection.InsertBreak Type:=wdPageBreak
    
    ' ================= СТРАНИЦА 4: БЕСПРОВОДНАЯ ПЕРЕДАЧА ДАННЫХ =================
    Selection.Style = doc.Styles(wdStyleHeading1)
    Selection.TypeText "Беспроводная передача данных"
    Selection.TypeParagraph
    
    Selection.Style = doc.Styles(wdStyleHeading2)
    Selection.TypeText "Li-Fi"
    Selection.TypeParagraph
    
    Selection.Style = doc.Styles(wdStyleNormal)
    Selection.Font.Bold = True
    Selection.TypeText "(Light Fidelity)"
    Selection.Font.Bold = False
    Selection.TypeText " — это двунаправленная, высокоскоростная беспроводная коммуникационная технология. Термин был придуман Харальдом Хаасом. Данный вид передачи данных использует видимый свет в открытом пространстве без волновода, как канал связи (в отличие от радиоволн в Wi-Fi). Таким образом Li-Fi принадлежит к технологиям VLC."
    Selection.TypeParagraph
    
    Selection.TypeText "Достоинства:"
    Selection.TypeParagraph
    
    Selection.Range.ListFormat.ApplyBulletDefault
    Selection.TypeText "Простота и дешевизна реализации;"
    Selection.TypeParagraph
    Selection.TypeText "Не требуется лицензия на использование;"
    Selection.TypeParagraph
    Selection.TypeText "Отсутствие радиодиапазона в технологии;"
    Selection.TypeParagraph
    Selection.TypeText "Видимый свет не вступает в противоречие с другими электромагнитными частотами, поэтому технологию Li-Fi можно применять, например: на борту самолёта или в медицинских учреждениях."
    Selection.TypeParagraph
    Selection.Range.ListFormat.RemoveNumbers
    
    Selection.Style = doc.Styles(wdStyleNormal)
    Selection.TypeText "Недостатки:"
    Selection.TypeParagraph
    
    Selection.Range.ListFormat.ApplyBulletDefault
    Selection.TypeText "Обязательная прямая видимость между приемником и передатчиком;"
    Selection.TypeParagraph
    Selection.TypeText "При яркой засветке, например, солнечным светом возможны сбои и ошибки в работе."
    Selection.TypeParagraph
    Selection.Range.ListFormat.RemoveNumbers
    
    ' Переход на 5-ю страницу
    Selection.InsertBreak Type:=wdPageBreak
    
    ' ================= СТРАНИЦА 5: ТАБЛИЦА ПО ГОСТ И ДИАГРАММА =================
    Selection.Style = doc.Styles(wdStyleHeading1)
    Selection.TypeText "Показатель роста численности населения в мире (июль 2011)"
    Selection.TypeParagraph
    
    Selection.Style = doc.Styles(wdStyleNormal)
    Selection.ParagraphFormat.FirstLineIndent = 0
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.TypeText "Таблица 1 — Показатель роста численности населения в мире (июль 2011)"
    Selection.TypeParagraph
    
    Dim countries As Variant
    Dim popText As Variant
    Dim popNum As Variant
    
    countries = Array("Китай", "Индия", "Соединенные Штаты", "Индонезия", "Бразилия", _
                      "Пакистан", "Бангладеш", "Нигерия", "Россия", "Япония", _
                      "Мексика", "Филиппины", "Эфиопия", "Вьетнам", "Египет")
                      
    popText = Array("1 336 718 015", "1 189 172 906", "313 232 044", "245 613 043", "203 429 773", _
                    "187 342 721", "158 570 535", "155 215 573", "138 739 892", "126 475 664", _
                    "113 724 226", "101 833 938", "90 873 739", "90 549 390", "82 079 636")
                    
    popNum = Array(1336718015#, 1189172906#, 313232044#, 245613043#, 203429773#, _
                   187342721#, 158570535#, 155215573#, 138739892#, 126475664#, _
                   113724226#, 101833938#, 90873739#, 90549390#, 82079636#)
    
    Set tbl = doc.Tables.Add(Range:=Selection.Range, NumRows:=16, NumColumns:=2)
    tbl.Borders.Enable = True
    
    tbl.Cell(1, 1).Range.Text = "Страна"
    tbl.Cell(1, 2).Range.Text = "Численность населения"
    tbl.Rows(1).Range.Font.Bold = True
    tbl.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    tbl.Rows(1).Range.ParagraphFormat.FirstLineIndent = 0
    
    For i = 0 To 14
        tbl.Cell(i + 2, 1).Range.Text = countries(i)
        tbl.Cell(i + 2, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        tbl.Cell(i + 2, 1).Range.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0.5)
        
        tbl.Cell(i + 2, 2).Range.Text = popText(i)
        tbl.Cell(i + 2, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        tbl.Cell(i + 2, 2).Range.ParagraphFormat.FirstLineIndent = 0
    Next i
    
    tbl.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
    tbl.Range.Font.Size = 12
    
    ' Перемещаем курсор под таблицу
    Selection.EndKey Unit:=wdStory
    Selection.TypeParagraph
    
    ' Построение диаграммы по таблице (п. 1.5)
    On Error Resume Next
    Set ils = doc.InlineShapes.AddChart(Type:=51, Range:=Selection.Range) ' 51 = xlColumnClustered
    If Not ils Is Nothing Then
        Set cht = ils.Chart
        cht.ChartData.Activate
        Set wb = cht.ChartData.Workbook
        Set ws = wb.Worksheets(1)
        
        ws.Cells.Clear
        ws.Cells(1, 1).Value = "Страна"
        ws.Cells(1, 2).Value = "Численность населения"
        
        For i = 0 To 14
            ws.Cells(i + 2, 1).Value = countries(i)
            ws.Cells(i + 2, 2).Value = popNum(i)
        Next i
        
        cht.SetSourceData Source:="='Лист1'!$A$1:$B$16"
        cht.SetSourceData Source:="='Sheet1'!$A$1:$B$16"
        cht.HasTitle = True
        cht.ChartTitle.Text = "Показатель роста численности населения в мире (июль 2011)"
        wb.Close
    End If
    On Error GoTo 0
    
    ' ================= П. 1.6 и 1.7: НУМЕРАЦИЯ И ПОДЛОЖКА «СЕКРЕТНО» =================
    For Each sec In doc.Sections
        ' Нумерация внизу по центру
        sec.Footers(wdHeaderFooterPrimary).PageNumbers.Add _
            PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True
            
        ' Подложка "СЕКРЕТНО" по диагонали
        Set shp = sec.Headers(wdHeaderFooterPrimary).Shapes.AddTextEffect( _
            PresetTextEffect:=msoTextEffect1, _
            Text:="СЕКРЕТНО", _
            FontName:="Times New Roman", _
            FontSize:=1, _
            FontBold:=msoFalse, _
            FontItalic:=msoFalse, _
            Left:=0, Top:=0)
            
        With shp
            .TextEffect.NormalizedHeight = msoFalse
            .Line.Visible = msoFalse
            .Fill.Visible = msoTrue
            .Fill.Solid
            .Fill.ForeColor.RGB = RGB(192, 192, 192)
            .Fill.Transparency = 0.5
            .Rotation = 315
            .LockAspectRatio = msoTrue
            .Width = CentimetersToPoints(16)
            .Height = CentimetersToPoints(4)
            .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
            .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
            .Left = wdShapeCenter
            .Top = wdShapeCenter
            .WrapFormat.AllowOverlap = True
            .WrapFormat.Type = wdWrapNone
        End With
    Next sec
    
    ' ================= П. 1.3: СБОРКА АВТООГЛАВЛЕНИЯ НА 1-М ЛИСТЕ =================
    doc.TablesOfContents.Add Range:=tocRange, _
        UseHeadingStyles:=True, _
        UpperHeadingLevel:=1, _
        LowerHeadingLevel:=3, _
        UseHyperlinks:=True
    doc.TablesOfContents(1).Update
    
    MsgBox "Лабораторная работа №6 полностью готова! :)", vbInformation, "Готово"
End Sub