Работа с фигурами в 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:
|
1 2 3 4 5 6 7 8 9 10 11 |
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 |
Результат работы кода:
Пример 2
Работа с одной фигурой:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
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:
|
1 2 3 4 5 6 7 8 9 10 11 |
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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
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 Next 'Создаем коллекцию ShapeRange и присваиваем ссылку на нее переменной myShapeRange Set myShapeRange = ActiveSheet.Shapes.Range(myArray) With myShapeRange 'Изменяем цвет всех фигур на рабочем листе .Fill.ForeColor.RGB = RGB(100, 150, 200) 'Поворачиваем все фигуры вокруг вертикальной оси .Flip msoFlipVertical End With End Sub |
Пример 5
Добавление надписи (текста) на фигуру:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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 |
Результат работы кода:
Изменить цвет текста, например на черный, можно двумя способами:
|
1 2 3 4 |
'С помощью константы 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 |
Удаление всех фигур с рабочего листа:
|
1 2 3 4 5 6 |
Sub Primer6() Dim myShape As Shape For Each myShape In ActiveSheet.Shapes myShape.Delete Next End Sub |
Здравствуйте!
Можно ли константы MsoAutoShapeType задавать переменными?
Что-то у меня не получается. Как ни пробую, всё Run-time error ’13’: Type mismatch.
Добрый вечер!
У меня работает:
То же самое при использовании текстовых значений констант MsoAutoShapeType:
Спасибо, лучший друг VBAшника Евгений!
У меня не работает при str = «msoShapeOctagon» и .AddShape str,…
Ваше решение меня выручает.
Можно ли наносить на Shapes надписи? И как, если да?
Не могу найти, а нужно срочно. Можно, разумеется ответить ссылкой.
Можно.
Спасибо! Добавлю в статью.
Добавил бы
здравствуйте
Если вопрос не по теме — просьба перенести в соответствующий раздел.
На рабочем Листе есть фигуры/картинки/фотографии…
которым присвоены свои имена («Прямоугольник 1», «Рисунок 2″…)
при копировании (внутри листа) они получают новые имена (фигура 12; рисунок 4 …)
У меня 2-а вопроса:
1) как макросом определить наименование картинки которая расположена в диапазоне D3:F5 ?
2) при изменении размера, встроенный компилятор показывает код:
какой написать код , чтобы машина выполняла действия ( изменение размера) без Selection ?
Добрый день, 0mega!
1) Как макросом определить наименование картинки, которая расположена в диапазоне D3:F5?
Так можно найти фигуру, левая верхняя точка которой находится в диапазоне D3:F5:
2) Какой написать код , чтобы машина выполняла действия (изменение размера) без Selection?
спасибо,
а как можно изменить имя напр. «Прямоугольник 1» — «figure12» ?
можно ли скопировать и сразу переименовать фигуру ?
ActiveSheet.Shapes(«Прямоугольник 1»).Name = «figure12»
Добрый день!
Как соединить кодом VBA две фигуры соединительной линией так, чтобы при перемещении одной из фигур соединитель не отрывался от нее?
Есть два объекта shapes. В одном стоит цифра. надо читать эту цифру и на основе цифры написать на другой объект shapes определенный текст. Заранее спасибо.
Привет, Надир!
Примерный код может быть таким:
Добрый день. Подскажите, пожалуйста, как для автофигуры назначить нажатие? Задача такая, что если по нажатию на автофигуру срабатывал бы код
Application.CommandBars.FindControl(ID:=1605).Execute, а при втором нажатии срабатывал бы кодApplication.CommandBars.FindControl(ID:=1605).ResetБуду очень благодарен.
Здравствуйте, Юрий!
Объявите переменную уровня модуля типа Boolean. При открытии файла, она будет иметь значение False. Пример кода: