Вставка существующего рисунка (фигуры, другого объекта) в ячейку Excel с помощью кода VBA. Подгон ячейки под размеры рисунка и фигуры под размеры ячейки.
Подгон ячейки под размеры рисунка
Вставка рисунка в ячейку из кода VBA Excel с подгоном размеров ячейки под размеры фигуры (картинки).
Сложность заключается в том, что высота и ширина рисунка (фигуры) и высота ячейки измеряются в точках (пунктах), а ширина ячейки (ширина столбца) измеряется в символах.
Хороший результат при вставке в ячейку небольших изображений дает приравнивание одного символа к пяти точкам.
Код VBA Excel для вставки рисунка в ячейку с подгоном размеров ячейки под размеры фигуры (картинки):
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Sub Primer1() With Лист20 .Shapes("Рисунок 1").Placement = xlMove 'изменяем ширину ячейки (столбца) в символах до 1/5 ширины рисунка в пунктах .Range("B3").ColumnWidth = .Shapes("Рисунок 1").Width / 5 'изменяем высоту ячейки (строки) до высоты рисунка + 10 точек для отступов .Range("B3").RowHeight = .Shapes("Рисунок 1").Height + 10 'задаем отступ рисунка от левого края ячейки на 5 пунктов .Shapes("Рисунок 1").Left = .Range("B3").Left + 5 'задаем отступ рисунка от верхнего края ячейки на 5 пунктов .Shapes("Рисунок 1").Top = .Range("B3").Top + 5 End With End Sub |
Свойству Placement объекта Shapes присваиваем значение константы xlMove, которое задает возможность перемещать рисунок вместе с ячейками, но не изменять его размеры при изменении размеров ячеек. Доступные константы из коллекции XlPlacement перечислены ниже.
Было:
Стало:
Подгон фигуры под размеры ячейки
Вставка рисунка в ячейку из кода VBA Excel с подгоном размеров картинки (фигуры) под размеры ячейки.
Чтобы сохранить пропорции рисунка при изменении его высоты до высоты ячейки, ширину картинки будем изменять во столько же раз, во сколько и высоту.
Код VBA Excel для вставки рисунков в ячейки с подгоном размеров картинок (фигур) под размеры ячеек:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Sub Primer2() Dim i As Byte, n As Single For i = 1 To 5 With Лист19 'определяем, во сколько раз будет изменена высота рисунка n = .Shapes(i).Height / .Cells(i, 1).Height .Shapes(i).Placement = xlMove 'изменяем высоту рисунка до высоты ячейки .Shapes(i).Height = .Cells(i, 1).Height 'изменяем ширину рисунка пропорционально изменению его высоты .Shapes(i).Width = .Shapes(i).Width / n 'выравниваем рисунок по левому краю ячейки .Shapes(i).Left = .Cells(i, 1).Left 'выравниваем рисунок по верхнему краю ячейки .Shapes(i).Top = .Cells(i, 1).Top End With Next End Sub |
Было:
Стало:
Константы из коллекции XlPlacement
Константы из коллекции XlPlacement определяют реакцию рисунка, фигуры или другого объекта из группы «Иллюстрации» на перемещение и изменение размеров ячеек, над которыми рисунок расположен.
Описание констант из коллекции XlPlacement:
| Константа | Значение | Описание |
|---|---|---|
| xlMoveAndSize | 1 | Объект перемещается и изменяет размеры вместе с ячейками |
| xlMove | 2 | Объект перемещается вместе с ячейками, но не изменяет размеры |
| xlFreeFloating | 3 | Объект не перемещается и не изменяет размеры вместе с ячейками |