1 Тема от Alex_Gur

  • Макросы для рисования прямоугольников и линий заданного размера в Word
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Тема: Макросы для рисования прямоугольников и линий заданного размера в Word

Макрос для рисования прямоугольника заданного размера в Word

Sub Rectangle01()
    Dim W As Single 'Длина прямоугольника в миллиметрах
    Dim H As Single 'Высота прямоугольника в миллиметрах
    Dim M As Single 'Масштаб
    Dim MM As Single 'Количество пунктов в 1 миллиметре
    
    W = 100 'Задается длина прямоугольника в миллиметрах
    H = 60 'Задается высота прямоугольника в миллиметрах
    M = 0.5 'Задается масштаб
    
    MM = Application.MillimetersToPoints(1)
    With ActiveDocument.Shapes.AddShape(msoShapeRectangle, 20 * MM, 30 * MM, 394, 130)
     .Fill.ForeColor.RGB = RGB(255, 255, 255) 'Цвет прямоугольника - белый
     .Line.Weight = 1 'Толщина границы прямоугольника - 1 пункт
     .Line.ForeColor.RGB = RGB(0, 0, 0) 'Цвет границы прямоугольника - черный
     .Select
    End With
    Selection.ShapeRange.Width = W * M * MM 'Формирование заданной длины прямоугольника
    Selection.ShapeRange.Height = H * M * MM 'Формирование заданной высоты прямоугольника
End Sub
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

2 Ответ от Alex_Gur

  • Макросы для рисования прямоугольников и линий заданного размера в Word
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Макросы для рисования прямоугольников и линий заданного размера в Word

Макрос для рисования линий заданного размера в Word

Sub Line01()
    Dim W As Single 'Длина линии в миллиметрах
    Dim M As Single 'Масштаб
    Dim MM As Single 'Количество пунктов в 1 миллиметре
    W = 200 'Задается длина линии в миллиметрах
    M = 0.5 'Задается масштаб
    
    MM = Application.MillimetersToPoints(1)
    With ActiveDocument.Shapes.AddLine(20 * MM, 30 * MM, 100, 30 * MM)
     .Line.Weight = 1 'Толщина границы линии - 1 пункт
     .Line.ForeColor.RGB = RGB(0, 0, 0) 'Цвет линии - черный
     .Select
    End With
    Selection.ShapeRange.Width = W * M * MM 'Формирование заданной длины линии
End Sub
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.