https://pastein.ru/t/6uf
Загрузка данных
Sub CreateLab2Document()
Dim doc As Document
Set doc = ActiveDocument
doc.Content.Delete
Dim sel As Selection
Set sel = Application.Selection
sel.HomeKey Unit:=wdStory
' --- 1. ТЕОРЕТИЧЕСКИЙ БЛОК ---
sel.ParagraphFormat.Alignment = wdAlignParagraphCenter
sel.Font.Name = "Times New Roman"
sel.Font.Size = 14
sel.Font.Bold = True
sel.TypeText "Центральный процессор" & vbCrLf
sel.ParagraphFormat.Alignment = wdAlignParagraphJustify
sel.ParagraphFormat.FirstLineIndent = CentimetersToPoints(1.25)
sel.ParagraphFormat.SpaceAfter = 6
sel.Font.Size = 12
sel.Font.Bold = False
sel.TypeText "(ЦП; также центральное процессорное CPU, дословно — центральное обрабатывающее устройство) — электронный блок либо интегральная схема (микропроцессор), исполняющая машинные инструкции (код программ), главная часть аппаратного обеспечения компьютера или программируемого логического контроллера. Иногда называют микропроцессором или просто процессором." & vbCrLf
sel.TypeText "Изначально термин центральное процессорное устройство описывал специализированный класс логических машин, предназначенных для выполнения сложных компьютерных программ. Вследствие довольно точного соответствия этого назначения функциям существовавших в то время компьютерных процессоров, он естественным образом был перенесён на сами компьютеры. Начало применения термина и его аббревиатуры по отношению к компьютерным системам было положено в 1960-е годы. Устройство, архитектура и реализация процессоров с тех пор неоднократно менялись, однако их основные исполняемые функции остались теми же, что и прежде." & vbCrLf
sel.TypeText "Главными характеристиками ЦПУ являются: тактовая частота, производительность, энергопотребление, нормы литографического процесса, используемого при производстве (для микропроцессоров) и архитектура." & vbCrLf
sel.ParagraphFormat.FirstLineIndent = 0
sel.TypeText vbCrLf
' --- 2. ПЕРВАЯ ТАБЛИЦА (Характеристики МП) ---
Dim t0 As Table
Set t0 = doc.Tables.Add(Range:=sel.Range, NumRows:=5, NumColumns:=6)
t0.Borders.Enable = True
' Объединение первой строки (заголовок)
t0.Cell(1, 1).Merge MergeTo:=t0.Cell(1, 6)
t0.Cell(1, 1).Range.Text = "Сравнить характеристики разных классов МП с ЖК - экраном"
t0.Cell(1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
t0.Cell(1, 1).Range.Font.Bold = True
Dim t0H As Variant
t0H = Array("Класс", "Процессор разрядность", "Память ОЗУ, Кбайт", "Размеры, мм", "Масса, кг", "Длительность работы от встроенных источников тока, Ч")
Dim colIdx As Long
For colIdx = 0 To 5
t0.Cell(2, colIdx + 1).Range.Text = t0H(colIdx)
t0.Cell(2, colIdx + 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
t0.Cell(2, colIdx + 1).Range.Font.Bold = True
Next colIdx
Dim t0Data As Variant
t0Data = Array( _
Array("HAND HELD PC", "4…8", "8…16", "240x140x30", "1,2", "30…300"), _
Array("LAPSIZEPC", "8", "16…64", "300x220x40", "не более 3", "до 20"), _
Array("FULL", "16", "64…768", "430…350…100", "не более 7", "до 8") _
)
Dim rIdx As Long
For rIdx = 0 To 2
For colIdx = 0 To 5
t0.Cell(rIdx + 3, colIdx + 1).Range.Text = t0Data(rIdx)(colIdx)
t0.Cell(rIdx + 3, colIdx + 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next colIdx
Next rIdx
' Переход за первую таблицу
t0.Range.Collapse wdCollapseEnd
sel.SetRange t0.Range.End, t0.Range.End
sel.TypeText vbCrLf
' --- 3. ВТОРАЯ ТАБЛИЦА (Статистический анализ букв) ---
Dim t1 As Table
Set t1 = doc.Tables.Add(Range:=sel.Range, NumRows:=35, NumColumns:=11)
t1.Borders.Enable = True
' Шапка: объединение под названия групп
t1.Cell(1, 10).Merge MergeTo:=t1.Cell(1, 11)
t1.Cell(1, 8).Merge MergeTo:=t1.Cell(1, 9)
t1.Cell(1, 6).Merge MergeTo:=t1.Cell(1, 7)
t1.Cell(1, 4).Merge MergeTo:=t1.Cell(1, 5)
t1.Cell(1, 2).Merge MergeTo:=t1.Cell(1, 3)
t1.Cell(1, 1).Range.Text = "Буква"
t1.Cell(1, 2).Range.Text = "1 группа"
t1.Cell(1, 3).Range.Text = "2 группа"
t1.Cell(1, 4).Range.Text = "3 группа"
t1.Cell(1, 5).Range.Text = "4 группа"
t1.Cell(1, 6).Range.Text = "Всего"
For colIdx = 1 To 6
t1.Cell(1, colIdx).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
t1.Cell(1, colIdx).Range.Font.Bold = True
Next colIdx
' Исходный массив (Буква, Гр1, Гр2, Гр3, Гр4)
Dim letters As Variant
letters = Array( _
Array("А", 39, 47, 47, 50), Array("Б", 10, 17, 17, 5), Array("В", 21, 22, 29, 21), _
Array("Г", 9, 7, 12, 5), Array("Д", 10, 12, 19, 18), Array("Е", 32, 49, 36, 44), _
Array("Ё", 0, 0, 1, 1), Array("Ж", 2, 3, 16, 3), Array("З", 8, 10, 16, 12), _
Array("И", 35, 39, 39, 46), Array("Й", 6, 7, 8, 8), Array("К", 12, 28, 17, 15), _
Array("Л", 19, 25, 19, 15), Array("М", 10, 20, 25, 17), Array("Н", 34, 30, 33, 46), _
Array("О", 47, 62, 51, 60), Array("П", 14, 20, 24, 20), Array("Р", 20, 34, 33, 38), _
Array("С", 25, 28, 25, 22), Array("Т", 29, 23, 34, 35), Array("У", 11, 10, 18, 13), _
Array("Ф", 0, 5, 2, 2), Array("Х", 5, 6, 8, 8), Array("Ц", 1, 6, 6, 6), _
Array("Ч", 5, 9, 8, 12), Array("Ш", 6, 11, 3, 6), Array("Щ", 4, 3, 1, 1), _
Array("Ъ", 1, 2, 0, 0), Array("Ы", 3, 12, 13, 5), Array("Ь", 10, 13, 12, 6), _
Array("Э", 1, 3, 6, 0), Array("Ю", 7, 1, 5, 11), Array("Я", 8, 23, 17, 8) _
)
Dim i As Long, rNum As Long
For i = 0 To UBound(letters)
rNum = i + 2
' Буква
t1.Cell(rNum, 1).Range.Text = letters(i)(0)
t1.Cell(rNum, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
' Группа 1: значение + формула частоты =B/444
If letters(i)(1) > 0 Then t1.Cell(rNum, 2).Range.Text = letters(i)(1)
t1.Cell(rNum, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
t1.Cell(rNum, 3).Formula Formula:="=B" & rNum & "/444", NumberFormat:="0,000"
t1.Cell(rNum, 3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
' Группа 2: значение + формула частоты =D/587
If letters(i)(2) > 0 Then t1.Cell(rNum, 4).Range.Text = letters(i)(2)
t1.Cell(rNum, 4).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
t1.Cell(rNum, 5).Formula Formula:="=D" & rNum & "/587", NumberFormat:="0,000"
t1.Cell(rNum, 5).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
' Группа 3: значение + формула частоты =F/600
If letters(i)(3) > 0 Then t1.Cell(rNum, 6).Range.Text = letters(i)(3)
t1.Cell(rNum, 6).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
t1.Cell(rNum, 7).Formula Formula:="=F" & rNum & "/600", NumberFormat:="0,000"
t1.Cell(rNum, 7).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
' Группа 4: значение + формула частоты =H/559
If letters(i)(4) > 0 Then t1.Cell(rNum, 8).Range.Text = letters(i)(4)
t1.Cell(rNum, 8).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
t1.Cell(rNum, 9).Formula Formula:="=H" & rNum & "/559", NumberFormat:="0,000"
t1.Cell(rNum, 9).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
' Всего по строке: формула суммы =B+D+F+H и формула частоты =J/2190
t1.Cell(rNum, 10).Formula Formula:="=B" & rNum & "+D" & rNum & "+F" & rNum & "+H" & rNum, NumberFormat:="0"
t1.Cell(rNum, 10).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
t1.Cell(rNum, 11).Formula Formula:="=J" & rNum & "/2190", NumberFormat:="0,000"
t1.Cell(rNum, 11).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
Next i
' Строка «Всего»: суммирование по столбцам =SUM(ABOVE)
t1.Cell(35, 1).Range.Text = "Всего"
t1.Cell(35, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
t1.Cell(35, 1).Range.Font.Bold = True
t1.Cell(35, 2).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0"
t1.Cell(35, 3).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0,000"
t1.Cell(35, 4).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0"
t1.Cell(35, 5).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0,000"
t1.Cell(35, 6).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0"
t1.Cell(35, 7).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0,000"
t1.Cell(35, 8).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0"
t1.Cell(35, 9).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0,000"
t1.Cell(35, 10).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0"
t1.Cell(35, 11).Formula Formula:="=SUM(ABOVE)", NumberFormat:="0,000"
For colIdx = 2 To 11
t1.Cell(35, colIdx).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
t1.Cell(35, colIdx).Range.Font.Bold = True
Next colIdx
' Подгонка ширины и обновление всех формул
t1.AutoFitBehavior wdAutoFitContent
doc.Fields.Update
End Sub