Inserting a picture into comment macro

[confusedjack]

Hi there,

I have a spreadsheet with 500 values, each with a seperate image. My objective is to have each of these images inserted as comments to their respective values, as having each one physically take up a cell would make the sheet too large to view.

Inserting these individually would take hours upon hours, so with help I've gotten this far:

Sub Insert_Comment_Picture()
Dim PicNo As Double

For PicNo = 1 To 2
Range("A" & PicNo).AddComment ("")
Range("A" & PicNo).Comment.Shape.Fill.UserPicture "C:\My Pictures\" & PicNo & ".jpg"
Next PicNo

End Sub

The problem with this is that it doesn't actually look at any values in cells, it only inserts the pictures in order.

Basically, I want the macro to look at the values in column E and insert the pics with the same name located in C:\My Pictures\ in column G.

Help please!

 

[repairman615]

At least we are trying.
I like it more when success happens after a strugle.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Insert_Comment_Picture()<br><br><SPAN style="color:#007F00">'''Uses column E:E and insert into column G:G</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> PicNo           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, _<br>    LR              <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, _<br>    c               <SPAN style="color:#00007F">As</SPAN> Range, _<br>    cRng            <SPAN style="color:#00007F">As</SPAN> Range, _<br>    FR              <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, _<br>    fPath           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, _<br>    Ws              <SPAN style="color:#00007F">As</SPAN> Worksheet, _<br>    rngComment      <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#00007F">Set</SPAN> Ws = ActiveSheet<br><br>fPath = "C:\Users\standard account\Pictures\"   <SPAN style="color:#007F00">'''Change to your file path</SPAN><br><SPAN style="color:#00007F">If</SPAN> Right(fPath, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fPath = fPath & "\"<br><br>FR = "E1"   <SPAN style="color:#007F00">'''First cell in column E:E  <------Change to suit</SPAN><br><br>LR = Ws.Range("E" & Rows.Count).End(xlUp).Row<br><SPAN style="color:#00007F">Set</SPAN> cRng = Ws.Range(FR & ":E" & LR)<br><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> cRng<br>        <SPAN style="color:#00007F">If</SPAN> c.Value = "" <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> (c.Offset(0, 2).Comment <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN>) <SPAN style="color:#00007F">Then</SPAN> c.Offset(0, 2).Comment.Delete<br>            <SPAN style="color:#00007F">GoTo</SPAN> SkipLoop<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rngComment = Ws.Range("G" & c.Row)<br>        <SPAN style="color:#00007F">With</SPAN> rngComment<br>            .Comment.Delete<br>            .AddComment<br>            .Comment.Shape.Fill.UserPicture fPath & c.Value & ".jpg"<br>            .Comment.Shape.ScaleWidth 3, msoFalse, msoScaleFromTopLeft<br>            .Comment.Shape.ScaleHeight 3, msoFalse, msoScaleFromTopLeft<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rngComment = <SPAN style="color:#00007F">Nothing</SPAN><br>SkipLoop:<br>    <SPAN style="color:#00007F">Next</SPAN> c<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Jaye7]

Still no go,

Maybe some Jack Daniels is required, or is that one of those Tennessee myths, like the Australian myth that we all ride Kangaroos in Australia.

 

[repairman615]

Oh, funny!

I would bet if we got Jack & Jack (or Jill) togather, they would have this settled by now.

 

[Jaye7]

This works.

Also picture path changed to my pic location.

Sub Insert_Comment_Picture()
'''Uses column E:E and insert into column G:G
Dim PicNo           As Integer, _
    LR              As Integer, _
    c               As Range, _
    cRng            As Range, _
    FR              As String, _
    fPath           As String, _
    Ws              As Worksheet, _
    rngComment      As Range
Set Ws = ActiveSheet
fPath = "C:\Users\Public\Pictures\Sample Pictures\"   '''Change to your file path
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
FR = "E1"   '''First cell in column E:E  <------Change to suit
LR = Ws.Range("E" & Rows.Count).End(xlUp).Row
Set cRng = Ws.Range(FR & ":E" & LR)
    On Error Resume Next
    For Each c In cRng
        If c.Value = "" Then
            If Not (c.Offset(0, 2).Comment Is Nothing) Then c.Offset(0, 2).Comment.Delete
            GoTo SkipLoop
        End If
 
 
        Set rngComment = Ws.Range("G" & c.Row)
        With rngComment
 
        If Not .Comment Is Nothing Then .Comment.Delete
        .AddComment
 
            .Comment.Shape.Fill.UserPicture fPath & c.Value & ".jpg"
            .Comment.Shape.ScaleWidth 3, msoFalse, msoScaleFromTopLeft
            .Comment.Shape.ScaleHeight 3, msoFalse, msoScaleFromTopLeft
        End With
 
        Set rngComment = Nothing
SkipLoop:
    Next c
    On Error GoTo 0
End Sub

 

[repairman615]

Nice, I am glad you got it!

Way to go.


-Jeff

 

[Jaye7]

Thanks for your help Jeff,

I have posted the working script on the other thread.

It is a nightmare trying to make something work for software that you don't use and you can't test it yourself, so I appreciate you hanging in there.