Solved: insert picture

[willemeulen]

I want vba to insert pictures into the cell comments of D6:D17 when Cell D3 changes/get updated

Cells D6:D17 contain the picture names like AA30016CP_02.jpg
Pictures are stored on C:\Storm



The code below gives me an error.

W

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Cmnt As Comment
Dim Pic As StdPicture

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("$D$3")) Is Nothing Then Exit Sub

For Each Cell In Range("D6:D17")

Set Pic = LoadPicture(Cell.Value)

Set Cmnt = Cell.Comment
If Cmnt Is Nothing Then
Set Cmnt = Cell.AddComment
Cmnt.Shape.TextFrame.Characters.Text = ""
End If

With Cmnt.Shape
.Height = Pic.Height / 25.4
.Width = Pic.Width / 25.4
.Fill.UserPicture "C:\Storm\"
End With

Next Cell

End Sub

[Bob Phillips]

You at least need the whole file name



Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Cmnt As Comment
Dim Pic As StdPicture

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("$D$3")) Is Nothing Then Exit Sub

For Each Cell In Range("D6:D17")

Set Pic = LoadPicture(Cell.Value)

Set Cmnt = Cell.Comment
If Cmnt Is Nothing Then
Set Cmnt = Cell.AddComment
Cmnt.Shape.TextFrame.Characters.Text = ""
End If

With Cmnt.Shape
.Height = Pic.Height / 25.4
.Width = Pic.Width / 25.4
.Fill.UserPicture "C:\Storm\" & Cell.Value
End With

Next Cell

End Sub

[Kenneth Hobs]

You will also need the full path in the LoadPicture. I also added a bit to skip if the file was not found or the cell was empty. This skipped the blank comment. You can code to add that or remove the blank comment part.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Cmnt As Comment
Dim Pic As StdPicture
Dim picPath As String, picPathName As String

If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("$D$3")) Is Nothing Then Exit Sub

picPath = "x:\pics\"

For Each Cell In Range("D6:D17")
picPathName = picPath & Cell.Value
If Dir(picPathName) = Empty Or Cell.Value2 = Empty Then GoTo NextCell
Set Pic = LoadPicture(picPathName)

Set Cmnt = Cell.Comment
If Cmnt Is Nothing Then
Set Cmnt = Cell.AddComment
Cmnt.Shape.TextFrame.Characters.Text = ""
End If

With Cmnt.Shape
.Height = Pic.Height / 25.4
.Width = Pic.Width / 25.4
.Fill.UserPicture picPathName
End With
NextCell:
Next Cell

End Sub

[Simon Lloyd]

Willelm, you are not new to using forums and as such should respect the forums rules, you have already been receiving help here http://www.thecodecage.com/forumz/members-excel-vba-programming/208150-insert-picture.html please read the link in my signature.

[willemeulen]

Sorry guys I was not aware of the cross posing thing, my appologies. Please find the link below.

Kind regards,

Willem van der Meulen

http://www.thecodecage.com/forumz/members-excel-vba-programming/208150-insert-picture.html

[willemeulen]

Got it working! The code from Kenneth Hobs works like a treat!

Thanks Kenneth

I have two small questions remaining how would I change height and width, is the current setup such that it shows the original size?

Secondly is about cell D3, this cell fires the macro. I see it only fires when actually changing input and hitting enter. How do would I make the macro fire when the cell changes. I use three different cells (with drop downs etc) to actually get to the total item number.

Cell D3 now shows =A1&A2&A3, when I change one of the three input cells the marco is not fired.

[Bob Phillips]

Would be nice if you told Leith over at CodeCage that you have it working, he has put in a lot of wasted effort for you.

[willemeulen]

already sent leith a private message thanking him for his efforts and saying his code is good, its me being a novice vba user that I am unable to sort out minor issues

[willemeulen]

Got the size issue figured, I just replaced the Pic.Height / 25.4 with a number, works just fine, the other issue of the triggers cell I will leave as it is. Recorded a macro to copy item from other sheets with shortcut and works like a bom with the picture macro.

Thanks all for the input.