Макрос вставляет изображение из файла PicturePath$
в центр диапазона ячеек ra, соблюдая пропорции картинки
Код надо разместить в модуле листа
(или заменить Me на Worksheets("ИмяЛиста")
Sub InsertImageIntoRange(ByVal PicturePath$, ByVal ra As Range) On Error Resume Next Dim sha As Shape With LoadPicture(PicturePath$) w! = .Width h! = .Height End With Const PADDING = 2 ' отступ от краёв ячейки MaxPicHeight! = ra.Height - 2 * PADDING MaxPicWidth! = ra.Width - 2 * PADDING wh_picture! = w / h wh_range! = MaxPicWidth! / MaxPicHeight! If wh_picture <= wh_range Then PicHeight! = MaxPicHeight! PicWidth! = wh_picture! * MaxPicHeight! Else PicWidth! = MaxPicWidth! PicHeight! = PicWidth! / wh_picture! End If 'Debug.Print "pic w = " & PicWidth, "pic h = " & PicHeight Set sha = Me.Shapes.AddPicture(PicturePath, False, True, -1, -1, PicWidth, PicHeight) sha.Top = ra.Top + (ra.Height - sha.Height) / 2 sha.Left = ra.Left + (ra.Width - sha.Width) / 2 ' sha.OnAction = Me.CodeName & ".ZoomImage" 'http://ExcelVBA.ru/code/ZoomImages End Sub
новая версия функции:
Sub InsertImageIntoRange(ByVal PicturePath$, ByVal ra As Range) On Error Resume Next Dim sha As Shape Const PADDING = 2 ' отступ от краев ячейки Set sha = ra.Worksheet.Shapes.AddPicture(PicturePath, False, True, -1, -1, -1, -1) sha.LockAspectRatio = msoTrue sha.Width = ra.Width - 2 * PADDING ' меняем ширину картинку ra.RowHeight = sha.Height + 2 * PADDING ' меняем высоту строки ' ставим картинку на место в ячейку sha.Top = ra.Top + (ra.Height - sha.Height) / 2 sha.Left = ra.Left + (ra.Width - sha.Width) / 2 End Sub
Пример использования:
sub test() InsertImageIntoRange "c:\folder\image1.jpg", Range("b2:d5") end sub
Комментарии
Дмитрий, добавил пример использования
День добрый!
Можно написать синтаксис вызова данной процедуры.
Спасибо
Здравствуйте, Антон!
Спасибо большое за ответ!
Добрый день, Игорь!
как гласит википедия
В некоторых диалектах Бейсика восклицательный знак, поставленный сразу после имени переменной, означает, что эта переменная — с плавающей запятой и обычной точности.
но насколько я понимаю, в данном случае он не является необходимостью, можно и без него.
Здравствуйте, Игорь. Подскажите, пожалуйста, зачем необходимы восклицательные знаки в переменных, что они означают? Заранее благодарен!
Как всё просто оказалось. Спасибо огромное и за решение и за быстрый ответ ).
А в чем проблема-то использовать макрос для увеличения картинок?
в этот макрос добавьте последней строкой
sha.OnAction = "ZoomImage" ' назначаем вставленной картинке макрос увеличения по щелку
ну и добавьте код макроса ZoomImage в тот же файл (в отдельный модуль)
Здравствуйте. А реально ли сделать так как в "Макрос для увеличения картинок по щелчку мыши"? Т.е. чтобы вставленная картинка по клику увеличивалась и уменьшалась. Полдня потратил, но так и не нашел решения.
Отправить комментарий