Add a picture from a folder with name specified in a cell

[devilzhead]

Hello everyone,

I am trying to find out a way where I can insert a picture in the active worksheet. The name of the picture is displayed in Cell A2. I want VBA to read the the picture name and find that particular file name in a specified folder or the same folder as the workbook and then insert the picture in one of the cells.

I know it is simple but I am getting a hard time. I searched for adding a picture code and was not very helpful. I have got something which is shown below.

Dim NameFound As Range
Dim fPath As String
Dim sImageCell As String

With Cells(2, 1)
TextBox1.Text = Cells(Row, 1)
Set NameFound = .Find(TextBox1.Value)
If NameFound Is Nothing Then
MsgBox ("Picture of") & TextBox1.Value & ("Not Found")
Else
With NameFound
fPath = ThisWorkbook.Path & "\"
Pcit = LoadPicture(fPath & "\" & TextBox1.Value & ".jpg")

'Select the cell where the picture has to be placed
GetCell:
Set PictCell = Application.InputBox("Select the cell to insert into", Type:=8)
If PictCell.Count > 1 Then MsgBox "Select ONE cell only": GoTo GetCell
PictCell.Select

'MsgBox ("Picture of") & TextBox1.Value
End With
End If
End With
Next
End Sub
***************************************
I am using clicking function to add the picture. After PictCell.Select I get stuck. I tried insert method and it does not work.

Any help in this matter will be greatly appreciated. Thanks.

[Kenneth Hobs]

Welcome to the forum!

Click the VBA button to insert code tags to make it easier for us to read your code and help you.

See: http://www.vbaexpress.com/forum/showthread.php?t=37784

[devilzhead]

Thanks for the help.

I got the inserting part working with my method. Right now the picture is placed which ever cell is selected. It would be nice if I can somehow put it in the code the cell where it should always place it.

I see that the code you posted in an earlier thread has the function to resize the image. I tried it but I am getting an error message. Is there some other way to resize the image?

Thanks.

[Kenneth Hobs]

What is your code? You get the best help when you help us help you.

[devilzhead]

Sorry about that.


Dim NameFound As Range
Dim fPath As StringSet NameFound = WCabDrw.Range("A5")
If NameFound Is Nothing Then
MsgBox ("Picture of") & WCabDrw.Range("A2") & ("Not Found")
Else
With NameFound
fPath = "G:\Sales & Marketing\Cable Drawings" & "\"
If Dir(fPath & "\" & NameFound & ".png") = "" Then
MsgBox ("Picture of") & WCabDrw.Range("A2") & ("Not Available")
Else
WCabDrw.Pictures.Insert(fPath & "\" & NameFound & ".png").Select
End If
End With
End If

[mdmackillop]

Two ways

Sub Macro1()

Dim c As Range
Set c = Selection
Range("C10").Activate
ActiveSheet.Pictures.Insert ("C:\a\pic.jpg")
c.Select
End Sub
'or
Sub Macro2()
Dim pic
Set pic = ActiveSheet.Pictures.Insert("C:\a\pic.jpg")
With Range("C10")
pic.Top = .Top
pic.Left = .Left
End With
End Sub

[Kenneth Hobs]

The code that I sent you to worked for me. Here is it in mdmackillop's code. Obviously, this needs error checking if the file might not exist.

Sub Macro3()
Dim pic As Object, r As Range, fPath As String

fPath = "x:\pics\"
Set pic = ActiveSheet.Pictures.Insert(fPath & Range("A2").Value2 & ".jpg")
Set r = Range("C10")
With pic
.Top = r.Top
.Left = r.Left
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 50#
.ShapeRange.Rotation = 0#
End With
End Sub