VBA Excel. Работа с фигурами (Shapes)

Работа с фигурами в VBA Excel: создание фигур методом Shapes.AddShape, типы фигур (MsoAutoShapeType), обращение к фигурам и изменение их свойств. Примеры.

Содержание

Объекты для работы с фигурами

Фигуры в VBA Excel представлены тремя объектами:

Объект	Описание
Shapes	Коллекция всех фигур на рабочем листе. Используется для создания новых фигур, для обращения к одной фигуре по имени и для перебора фигур циклом.
ShapeRange	Коллекция нескольких фигур, аргументом которой является массив имен выбранных объектов. Используется для редактирования сразу всех фигур, входящих в эту коллекцию.
Shape	Объект, представляющий одну фигуру. Используется для редактирования одной этой фигуры.

Создание фигур в VBA Excel

Фигуры в VBA Excel создаются методом Shapes.AddShape.

Синтаксис метода AddShape

1	Shapes.AddShape (Type, Left, Top, Width, Height)

Shapes — выражение, возвращающее коллекцию фигур на рабочем листе, например: ActiveSheet.Shapes.

Параметры метода AddShape

Параметр	Описание
Type	Константа из коллекции MsoAutoShapeType, определяющая тип создаваемой фигуры.
Left	Расстояние от левой границы фигуры до левой границы табличной части рабочего листа в пунктах.. Тип данных — Single.
Top	Расстояние от верхней границы фигуры до верхней границы табличной части рабочего листа в пунктах.. Тип данных — Single.
Width	Ширина фигуры по внешним границам в пунктах.
Height	Высота фигуры по внешним границам в пунктах.

Все параметры метода Shapes.AddShape являются обязательными.

Константы MsoAutoShapeType

Константы коллекции MsoAutoShapeType, определяющие основные типы создаваемых фигур:

Константа	Значение	Тип фигуры
msoShapeRectangle	1	Прямоугольник
msoShapeParallelogram	2	Параллелограмм
msoShapeTrapezoid	3	Трапеция
msoShapeDiamond	4	Ромб
msoShapeRoundedRectangle	5	Прямоугольник: скругленные углы
msoShapeOctagon	6	Восьмиугольник (октаэдр)
msoShapeIsoscelesTriangle	7	Равнобедренный треугольник
msoShapeRightTriangle	8	Прямоугольный треугольник
msoShapeOval	9	Овал
msoShapeHexagon	10	Шестиугольник (гексаэдр)
msoShapeCross	11	Крест
msoShapeRegularPentagon	12	Пятиугольник (пентаэдр)
msoShapeCan	13	Цилиндр
msoShapeCube	14	Куб
msoShapeDonut	18	Круг: прозрачная заливка (кольцо)
msoShapeLightningBolt	22	Молния
msoShapeSun	23	Солнце
msoShapeMoon	24	Месяц (луна)
msoShape5pointStar	92	Звезда: 5 точек (пятиконечная)
msoShapeCloud	179	Облако

Все доступные константы из коллекции MsoAutoShapeType смотрите на сайте разработчиков.

Создание объекта ShapeRange

Создание коллекции ShapeRange из выбранных фигур:

1 2	Dim myShapeRange As ShapeRange Set myShapeRange = ActiveSheet.Shapes.Range(Array("Пятиугольник 140", "Солнце 141", "Облако 144"))

Объектная переменная myShapeRange не обязательна, можно обратиться непосредственно к возвращенной коллекции, например, присвоив всем ее элементам синий цвет:

1	ActiveSheet.Shapes.Range(Array("Пятиугольник 140", "Солнце 141", "Облако 144")).Fill.ForeColor.RGB = vbBlue

Примеры работы с фигурами

Пример 1

Создание пяти разных фигур из кода VBA Excel методом Shapes.AddShape:

Sub Primer1()

With ActiveSheet.Shapes

'При создании фигуры без присвоения ее переменной скобки не нужны

.AddShape msoShapeCube, 30, 40, 72, 72

.AddShape msoShapeIsoscelesTriangle, 130, 40, 72, 72

.AddShape msoShapeSun, 230, 40, 72, 72

.AddShape msoShapeLightningBolt, 330, 40, 72, 72

'Чтобы выбрать фигуру, параметры необходимо заключить в скобки

.AddShape(msoShapeCloud, 430, 40, 72, 72).Select

End With

End Sub

Результат работы кода:

Фигуры на листе Excel

Пример 2

Работа с одной фигурой:

Sub Primer2()

Dim myShape As Shape

'Создаем фигуру "Месяц" и присваивает ссылку на нее переменной myShape

Set myShape = ActiveSheet.Shapes.AddShape(msoShapeMoon, 50, 50, 80, 80)

With myShape

'Меняем высоту и ширину фигуры

.Height = 150

.Width = 100

'Меняем цвет фигуры

.Fill.ForeColor.RGB = vbYellow

'Поворачиваем фигуру влево на 40 градусов

.Rotation = -40

End With

End Sub

Пример 3

Редактирование одновременно нескольких фигур с помощью коллекции ShapeRange:

Sub Primer3()

With ActiveSheet.Shapes.Range(Array("Овал 1", "Овал 2", "Овал 3"))

'Меняем цвет всех фигур из коллекции ShapeRange

.Fill.ForeColor.RGB = vbBlue

'Задаем высоту и ширину овалов

.Height = 150

.Width = 50

'Поворачиваем фигуры вправо на 45 градусов

.Rotation = 45

End With

End Sub

Пример 4

Редактирование одновременно всех фигур на рабочем листе с помощью коллекции ShapeRange:

Sub Primer4()

Dim myShapeRange As ShapeRange, i As Integer, _

myShape As Shape, myArray() As String

'Задаем массиву размерность от 1 до количества фигур на листе

ReDim myArray(1 To ActiveSheet.Shapes.Count)

'Проходим циклом по всем фигурам коллекции и записываем их имена в массив

For Each myShape In ActiveSheet.Shapes

i = i + 1

myArray(i) = myShape.Name

'Создаем коллекцию ShapeRange и присваиваем ссылку на нее переменной myShapeRange

Set myShapeRange = ActiveSheet.Shapes.Range(myArray)

With myShapeRange

'Изменяем цвет всех фигур на рабочем листе

.Fill.ForeColor.RGB = RGB(100, 150, 200)

'Поворачиваем все фигуры вокруг вертикальной оси

.Flip msoFlipVertical

End With

End Sub

Пример 5

Добавление надписи (текста) на фигуру:

Sub Primer5()

Dim myShape As Shape

Set myShape = ActiveSheet.Shapes.AddShape(msoShapeCloud, 50, 30, 300, 300)

With myShape.TextFrame2

'Добавление текста на фигуру

.TextRange.Characters.Text = "Объект TextFrame представляет текстовую рамку в объекте Shape. Содержит текст в текстовом кадре, а также свойства и методы, которые контролируют выравнивание и закрепление текстового кадра."

'Задаем курсивное начертание

.TextRange.Characters.Font.Italic = True

'Указываем размер шрифта

.TextRange.Characters.Font.Size = 13

'Отступ левой границы текстового поля от левой внутренней границы фигуры

.MarginLeft = 30

'Отступ верхней границы текстового поля от верхней внутренней границы фигуры

.MarginTop = 20

End With

End Sub

Результат работы кода:

Фигура Облако с надписью

Изменить цвет текста, например на черный, можно двумя способами:

'С помощью константы MsoThemeColorIndex

myShape.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1

'С помощью цветовой модели RGB

myShape.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)

С константами из коллекции MsoThemeColorIndex вы можете ознакомиться на сайте разработчиков.

Пример 6

Удаление фигур с рабочего листа из кода VBA Excel с помощью метода Delete.

Удаление одной фигуры:

1	ActiveSheet.Shapes("Ромб 5").Delete

Удаление нескольких фигур:

1	ActiveSheet.Shapes.Range(Array("Овал 1", "Овал 2", "Овал 3")).Delete

Удаление всех фигур с рабочего листа с помощью цикла:

Sub Primer6()

Dim myShape As Shape

For Each myShape In ActiveSheet.Shapes

myShape.Delete

End Sub

В 7 примере рассмотрено удаление всех фигур без цикла.

Пример 7

Выделение всех фигур на рабочем листе:

1	ActiveSheet.Shapes.SelectAll

Выбор всех фигур и удаление выбранного (всех фигур):

Sub Primer7()

ActiveSheet.Shapes.SelectAll

Selection.Delete

End Sub

Продолжение темы в статье VBA Excel. Копирование, перемещение и поворот фигур.

Содержание рубрики VBA Excel по тематическим разделам со ссылками на все статьи.

98 комментариев для “VBA Excel. Работа с фигурами (Shapes)”

ЕвгенияУ 18.01.2023 в 16:03

Евгений,здравствуйте! Еще раз спасибо большое за Вашу помощь.
Прошу прощения что вновь задаю вопрос,но в этот же документе теперь появилась другая проблема. Как я понимаю она опять-таки связана с макросом.
Текст при необходимости переносится на вторую строку,но при выводе на печать во всех полях печатается только то что попадает в первую строку.

Евгений 18.01.2023 в 19:48

Здравствуйте, Евгения!
Попробуйте закомментировать

name="один"

addUnitLabel ws,10*0,10*0,500,10,True,name,getCellValue(name)

name="два"