hello,
I hope to find some help here as I would really like to find an easier way than just insert each picture manually. I have range of cells value which I need to add pictures for (hundred of cells values). For this example cell values:
B1: Desert
B2: Jellyfish
B3: Koala
I'm looking to insert image so these values into column A. If there is no pictures then text "No picture found" should appear. Someone wrote VBA which I modified slightly but pictures are not showing.
Sub Load_Picture()
Dim Entry As Range
Dim WorkArea As Range
Dim Source As Worksheet
With Application
.ScreenUpdating = False
End With
Set Source = Sheets("Sheet1")
Set WorkArea = Source.Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))
For Each Entry In WorkArea
PicturePath = Dir("C:\Users\Public\Pictures\Sample Pictures" & ".jpg")
If PicturePath <> "" Then
Set Shp = ActiveSheet.Shapes.AddPicture(Filename:="C:\Users\Public\Pictures\Sample Pictures" & ".jpg" _
, LinkToFile:=False, SaveWithDocument:=True, Left:=Cells(Entry.Row, 1).Left, Top:=Cells(Entry.Row, 1).Top _
, Width:=Cells(Entry.Row, 1).Width, Height:=Cells(Entry.Row, 1).Height)
Shp.Placement = xlMoveAndSize
Shp.ControlFormat.PrintObject = True
Else
Entry.Offset(0, -1).Value = "Picture Not Found"
End If
Next Entry
End Sub
_______________________________
VBA does seem to work because it places "Pictures Not Found" in the column A for all B1-B3 values. But how to get the actual pictures in Column A? Is there something missing in the VBA?
Thank you for your help.
I hope to find some help here as I would really like to find an easier way than just insert each picture manually. I have range of cells value which I need to add pictures for (hundred of cells values). For this example cell values:
B1: Desert
B2: Jellyfish
B3: Koala
I'm looking to insert image so these values into column A. If there is no pictures then text "No picture found" should appear. Someone wrote VBA which I modified slightly but pictures are not showing.
Sub Load_Picture()
Dim Entry As Range
Dim WorkArea As Range
Dim Source As Worksheet
With Application
.ScreenUpdating = False
End With
Set Source = Sheets("Sheet1")
Set WorkArea = Source.Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))
For Each Entry In WorkArea
PicturePath = Dir("C:\Users\Public\Pictures\Sample Pictures" & ".jpg")
If PicturePath <> "" Then
Set Shp = ActiveSheet.Shapes.AddPicture(Filename:="C:\Users\Public\Pictures\Sample Pictures" & ".jpg" _
, LinkToFile:=False, SaveWithDocument:=True, Left:=Cells(Entry.Row, 1).Left, Top:=Cells(Entry.Row, 1).Top _
, Width:=Cells(Entry.Row, 1).Width, Height:=Cells(Entry.Row, 1).Height)
Shp.Placement = xlMoveAndSize
Shp.ControlFormat.PrintObject = True
Else
Entry.Offset(0, -1).Value = "Picture Not Found"
End If
Next Entry
End Sub
_______________________________
VBA does seem to work because it places "Pictures Not Found" in the column A for all B1-B3 values. But how to get the actual pictures in Column A? Is there something missing in the VBA?
Thank you for your help.