Cipariz (Автор тем)

Вставка изображения в соответствии со значением ячейки

Пользователь

Сообщений: 8 Регистрация: 14.01.2014

14.01.2014 15:43:58

Добрый день Великие!
Столкнулся с проблемой: Данные в файле формируются посредством ВПР из разных баз. Единственное с чем не получается - это изображение.
Действие происходит следующим образом: в ячейку "K1" вписывается ФИО человека, по этому ФИО данные собираются с разных мест. Есть папка с изображениями "C:\System32\Picture\Avatar\", где названия фото соответствуют ФИО людей.
Мне необходимо чтобы фото тоже подтягивалось из папки в ячейку "I5" (или диапазон ячеек) - оптимально по ширине или высоте ячейки (выравнивание по левому краю).
Перерыв интернет нашел только такую формулу, но в ней разобраться полностью не могу:

Код

Sub Vstavka_Kartinok() 
Sheets("Лист1").Select 
x = 1 
Range("A1").Select 
While Sheets("Лист1").Cells(x, 2).Text <> "" 
x = x + 1 
Wend 
x = x - 1 
For i = 2 To x 
kartinka = Sheets("Лист1").Cells(i, 2).Value 
Range("E" & CStr(i)).Select 
Dim SR As ShapeRange 

ActiveSheet.Pictures.Insert("C:\1\" & CStr(kartinka) & ".jpg").Select 
'Set SR = Selection.ShapeRange 

[B]Selection.ShapeRange.Left = 200 
Selection.ShapeRange.Top = 100 * (i - 2)[/B] 

Selection.ShapeRange.LockAspectRatio = msoFalse 
Selection.ShapeRange.Height = 152.2 
Selection.ShapeRange.Width = 183.75 
Selection.ShapeRange.Rotation = 0# 
Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft 
Next i 
MsgBox ("Изображение загружено") 
End Sub 

Sub InsertShapeNode() 
ActiveSheet.Shapes(1).Select 
With Selection.ShapeRange 
If .Type = msoFreeform Then 
.Nodes.Insert _ 
Index:=3, SegmentType:=msoSegmentCurve, _ 
EditingType:=msoEditingSymmetric, X1:=35, Y1:=100 
.Fill.ForeColor.RGB = RGB(0, 0, 200) 
.Fill.Visible = msoTrue 
Else 
MsgBox "This shape is not a Freeform object." 
End If 
End With 
End Sub

Помогите гуманитарию, если сталкивались с такой проблемой!

Перейти