Insert user pics into shapes in worksheet

[Stefan_Sand]

Hello,

I want ot insert preperated user pics in the same folder as the active worksheet into corresponding shapes.

I tried to use the following codelines in the attached workbook, but it doesn´t work.

Sub InsertPic()
' Get Pictures into Shape
Application.Calculation = xlCalculationManual
Dim r As Long
Dim m As Long
Dim shp As Shape
m = Range("F" & Rows.Count).End(xlUp).Row
On Error Resume Next
For r = 3 To m
Set shp = ActiveSheet.Shapes(Range("F" & r)).Fill.UserPicture(ThisWorkbook.Path & "\img" & Range("F3").Value & ".jpg")

Next r
Application.Calculation = xlCalculationAutomatic
End Sub

what is going wrong, or, where am i wrong? Can you help me out, please?
Thanks in advance,
Stef

[HansV]

Which of the above pictures is you?

Are you sure that you attached the correct workbook? The code in your post refers to column F, but column F is blank in both worksheets.

[Stefan_Sand]

Hahahaha, I always loved Your sense of humor, Hans.
My question was, where shall i put the reference column right.
When i refer to column B i get the angry birds pig into 1.3.1 and 1.3.2 and if i set it to column E i get my picture in both shapes.
How do i have to change the code to work right? - in column F should be the number of the corresponding image inside the same folder of the workbook to the named shape in the workbook.

[HansV]

I'm afraid I don't understand. What are 1.3.1 and 1.3.2? I don't see them anywhere in the workbook.
And columns B and E are also empty.

But your line

Code: Select all

Set shp = ActiveSheet.Shapes(Range("F" & r)).Fill.UserPicture(ThisWorkbook.Path & "\img" & Range("F3").Value & ".jpg")

should probably be

Code: Select all

Set shp = ActiveSheet.Shapes(Range("F" & r)).Fill.UserPicture(ThisWorkbook.Path & "\img" & Range("F" & r).Value & ".jpg")

Otherwise you'll get the same picture each time.

[Stefan_Sand]

now i see, i inserted the wrong base file.
I only want the corresponding jpgs being inserted into the named shapes in the list.

[HansV]

Aaargh -
You can't use Set shp = ... AND also set its FillFormat. This should work:

Code: Select all

Sub InsertPic()
  ' Get Pictures into Shape
  Application.Calculation = xlCalculationManual
  Dim r As Long
  Dim m As Long
  m = Range("B" & Rows.Count).End(xlUp).Row
  On Error Resume Next
  For r = 3 To m
    ActiveSheet.Shapes(Range("B" & r).Value).Fill.UserPicture ThisWorkbook.Path & "\img" & Range("F" & r).Value & ".jpg"
  Next r
  Application.Calculation = xlCalculationAutomatic
End Sub

Note that I used Shapes(Range("B" & r).Value) instead of Shapes(Range("F" & r).Value)

[Stefan_Sand]

okok, i understand now , what you mean, Hans...... sorry, don´t hit me again, Master ... ;)

Happy Eastern to your family and you, Hans,
best regards,
Stef

[HansV]

Frohe Ostern