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


Sub CreateLabWork7()
    Dim doc As Document
    Set doc = ActiveDocument
    
    Dim rng As Range
    Set rng = doc.Content
    rng.Collapse Direction:=wdCollapseEnd
    
    ' Базовые настройки шрифта
    doc.Content.Font.Name = "Times New Roman"
    doc.Content.Font.Size = 12
    
    ' Заголовки
    With rng
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .ParagraphFormat.SpaceAfter = 6
        .InsertAfter "Лабораторная работа 7" & vbCrLf
        .InsertAfter "Ввод форматирование, редактирование данных" & vbCrLf & vbCrLf
        
        ' Цель работы
        .Font.Bold = True
        .InsertAfter "Цель работы: "
        .Collapse Direction:=wdCollapseEnd
        
        .Font.Bold = False
        .InsertAfter "Овладеть умениями: набирать числа, текст, формулы, редактировать и форматировать данные, копировать формулы, используя маркер заполнения, использовать относительные и абсолютные ссылки." & vbCrLf & vbCrLf
        .Collapse Direction:=wdCollapseEnd
        
        ' 1. Порядок работы
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Font.Bold = True
        .InsertAfter "1. Порядок работы" & vbCrLf
        .Collapse Direction:=wdCollapseEnd
        
        ' Таблица №1
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Font.Bold = False
        .InsertAfter "Таблица №1" & vbCrLf
        .Collapse Direction:=wdCollapseEnd
        
        ' ТОВАРЫ
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .InsertAfter "ТОВАРЫ" & vbCrLf
        .Collapse Direction:=wdCollapseEnd
    End With
    
    ' Создание таблицы (13 строк, 4 столбца)
    Dim tbl As Table
    Set tbl = doc.Tables.Add(Range:=rng, NumRows:=13, NumColumns:=4)
    
    ' Настройка границ таблицы
    With tbl.Borders
        .InsideLineStyle = wdLineStyleSingle
        .OutsideLineStyle = wdLineStyleSingle
    End With
    
    ' Заголовки таблицы
    tbl.Cell(1, 1).Range.Text = "Номер"
    tbl.Cell(1, 2).Range.Text = "Наименование" & vbCrLf & "товара"
    tbl.Cell(1, 3).Range.Text = "Цена"
    tbl.Cell(1, 4).Range.Text = "Цена"
    
    ' Массив данных для заполнения
    Dim data As Variant
    data = Array( _
        Array("101", "Компьютер Р5-66", "$ 999,00", "12 987,00 р."), _
        Array("102", "КомпьютерР5-100", "$ 1 500,00", "19 500,00 р."), _
        Array("103", "Компьютер 486-66", "$ 780,00", "10 140,00 р."), _
        Array("104", "Компьютер 486-75", "$ 819,00", "10 647,00 р."), _
        Array("201", "Принтер лазерный ОХ", "$ 1 300,00", "16 900,00 р."), _
        Array("202", "Принтер лазерный ПХ", "$ 740,00", "9 620,00 р."), _
        Array("203", "Принтер струйный ЧБ", "$ 299,00", "3 887,00 р."), _
        Array("204", "Принтер струйный Ц", "$ 460,00", "5 980,00 р."), _
        Array("301", "Монитор 14”", "$ 220,00", "2 860,00 р."), _
        Array("302", "Монитор 15”", "$ 337,00", "4 381,00 р."), _
        Array("304", "Монитор 17”", "$ 518,00", "6 724,00 р.") _
    )
    
    Dim i As Integer, j As Integer
    For i = 0 To 10
        For j = 0 To 3
            tbl.Cell(i + 2, j + 1).Range.Text = data(i)(j)
        Next j
    Next i
    
    ' Убираем внутренние горизонтальные границы между строками данных (как на образце)
    For i = 2 To 11
        tbl.Rows(i).Borders(wdBorderBottom).LineStyle = wdLineStyleNone
    Next i
    
    ' Последняя строка: объединение ячеек под "Курс доллара"
    tbl.Cell(13, 1).Merge MergeTo:=tbl.Cell(13, 2)
    tbl.Cell(13, 1).Range.Text = "Курс доллара"
    tbl.Cell(13, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    
    tbl.Cell(13, 2).Merge MergeTo:=tbl.Cell(13, 3)
    tbl.Cell(13, 2).Range.Text = "13р."
    tbl.Cell(13, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    tbl.Cell(13, 1).Borders(wdBorderRight).LineStyle = wdLineStyleNone
    
    ' Настройка ширины столбцов и отступов внутри таблицы
    tbl.Range.ParagraphFormat.SpaceAfter = 0
    tbl.Columns(1).PreferredWidth = CentimetersToPoints(1.8)
    tbl.Columns(2).PreferredWidth = CentimetersToPoints(6.2)
    tbl.Columns(3).PreferredWidth = CentimetersToPoints(3.2)
    tbl.Columns(4).PreferredWidth = CentimetersToPoints(3.2)
    
    ' Переход курсора под таблицу для добавления списка заданий
    Set rng = doc.Content
    rng.Collapse Direction:=wdCollapseEnd
    rng.InsertParagraphAfter
    rng.Collapse Direction:=wdCollapseEnd
    
    With rng
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .ParagraphFormat.SpaceAfter = 2
        .InsertAfter "1.1. В ячейке A1-D1 введите заголовок столбцов." & vbCrLf
        .InsertAfter "1.2. Заполните таблицу №1 кроме столбца D. В столбец С ввести целые числа." & vbCrLf
        .InsertAfter "1.3. Выделите строку с заголовками столбцов и установите параметры шрифта (полужирный, 11 пт), выровняйте заголовки столбцов по центру и обеспечьте в ячейке «В1» двух строчное расположение заголовка." & vbCrLf
        .InsertAfter "1.4. Установите ширину столбца «В» в соответствии с шириной текста." & vbCrLf
        .InsertAfter "1.5. В первую ячейку столбца «D» введите формулу для расчета цены товара в рублях и скопируйте еев другие ячейки столбца." & vbCrLf
        .InsertAfter "1.6. Установите для чисел столбцов «С» и «D» требуемые форматы." & vbCrLf
        .InsertAfter "1.7. Постройте рамку." & vbCrLf
        .InsertAfter "1.8. Сохраните в файл с именем «3А1» (номер по журналу) в папку своей группы." & vbCrLf
        .InsertAfter "1.9. Покажите результат преподавателю."
    End With
End Sub