Вставка картинки в ячейку программно

@Aumi · Регистрация: 08.10.2015

Author24 — интернет-сервис помощи студентам

Здравствуйте,

Есть два столбца: id, рисунок
имя картинки состоит из id. Например, id=111, а рисунок 111.jpg.
Я установила высоту строки=200,
Мой код:

Visual Basic

Public Sub insPic()
 
   Application.ScreenUpdating = False
 
Dim BookID As String, T As String, myDir As String
 
myDir = "C:\Users\user\Pictures\"
ID = Range("A1")
T = ".jpg"
 
ActiveSheet.Shapes.AddPicture Filename:=myDir & ID & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=200, Height:=200
 
Application.ScreenUpdating = True

Дело в том, что картинка вставится в выделенную ячейку. Как сделать, чтобы картинка была в В2?

Было бы вообще замечательно, если подскажите,как сделать так, чтобы циклом вставлялись картинки? ID будут в А1-А10,а рисунки их соответсвенно в В1-В10. Макрос или процедура неважно.

@pashulka · 07.10.2017, 19:46

Visual Basic

Private Sub Test()
   Application.ScreenUpdating = False
   Dim iPath$, iCell As Range
   iPath = "C:\Users\User\Pictures\"
   For Each iCell In [A1:A10]
       With ActiveSheet.Pictures.Insert(iPath & iCell & ".jpg")
            .Top = iCell(1, 2).Top:     .Left = iCell(1, 2).Left
            .Width = iCell(1, 2).Width: .Height = iCell(1, 2).Height
       End With
    Next
    Application.ScreenUpdating = True
End Sub

Visual Basic

Private Sub Test2()
   Application.ScreenUpdating = False
   Dim iPath$, iCell As Range
   iPath = "C:\Users\User\Pictures\"
   For Each iCell In [A1:A10]
       ActiveSheet.Shapes.AddPicture iPath & iCell & ".jpg", _
       False, True, iCell(1, 2).Left, iCell(1, 2).Top, iCell(1, 2).Width, iCell(1, 2).Height
    Next
    Application.ScreenUpdating = True
End Sub

Если не хотите, чтобы исходные размеры картинок менялись, то в первом варианте уберите .Width и .Height, а во втором, вместо ширины и длины ячейки просто укажите -1
Если же размеры картинки всё же нужно подогнать под размеры ячеек, то определять каждый раз ширину столбца в цикле, не имеет особого смысла, проще говоря, это можно сделать один раз (перед циклом), а затем использовать полученное значение.

@Aumi · 08.10.2017, 12:41 **[ТС]**

pashulka,Благодарю вас за ответ!
Тут дело поменялось, сумеете помочь? Хотят, чтобы это была процедура. Чтобы в ячейке прописывалась формула и вниз тянули.
Не подскажите, как преобразовать? Я начала, вот только не знаю, как возвращаемое значение приткнуть

Visual Basic

 Public Function Pic(v)
   Application.ScreenUpdating = False
   Dim iPath$, iCell As Range
   iPath = "C:\Users\User\Pictures\"
 '  For Each iCell In [A1:A2]
       ActiveSheet.Shapes.AddPicture iPath & v & ".jpg", _
       False, True, iCell(1, 2).Left, iCell(1, 2).Top, iCell(1, 2).Width, iCell(1, 2).Height
  '  Next
    Application.ScreenUpdating = True
End Function

@pashulka · 08.10.2017, 13:00

Visual Basic

Public Function Pic(c As Range)
    ActiveSheet.Shapes.AddPicture "C:\Users\User\Pictures\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function

Если хотите импортировать картинку с привязкой к ячейке с UDF, то :

Visual Basic

Public Function Pic(c As Range)
    With Application.Caller 'Application.ThisCell
         ActiveSheet.Shapes.AddPicture _
         "C:\Users\User\Pictures\" & c & ".jpg", _
         False, True, .Left, .Top, .Width, .Height
    End With
End Function

@Aumi · 09.10.2017, 11:10 **[ТС]**

pashulka, Оба варианта не хотят всавлять картинки.
если я в ячейке пишу =Pic(A1) ,то ошибка значении,
а если второй вариант, то Ошибка-неправильная ссылка на ячейку

Добавлено через 1 час 4 минуты
В первом варианте работает этот

Visual Basic

Public Function Pic(c) As Range
     ActiveSheet.Shapes.AddPicture "C:\Users\User\Pictures\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function

Но не получается тянуть формулу вниз.
Каждый раз приходится прописывать формулу в В1 и В2

Добавлено через 28 минут
Поняла в чем ошибка, короче формулу нужно писать в соседнем столбце, тогда все тянется вниз и картинки вставляются

@mor_sergey · 10.06.2020, 13:48

pashulka, pashulka, ребят, ничего подходящего не нахожу...мне нужно по условиям из выпадающих списков строить схемы..картинка в колонке Форма просто для южера...как выглядит....строить нужно из элементов.
пробывал макрокордером....не понял как к это перенять

Visual Basic

1 2	ActiveSheet.Shapes.AddShape(msoShapeFlowchartDecision, 545.25, 39, 72, 48.24). _ Select

	10.06.2020, 13:48

Вставка картинки в ячейку программно

Решение