Sources Code
Sub Insert_Picture_Comment()
On Error Resume Next
Dim PicturePath As String
Dim CommentBox As Comment
Dim i, lastrow As Long
'Defind Last row
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop ntil Last row from row 2
For i = 2 To lastrow
PicturePath = "C:\Users\imac\Desktop\Image\" & Cells(i, 1) & ".JPG"
' existing comments clear
Cells(i, 1).ClearComments
'Create a New Cell Comment
Set CommentBox = Cells(i, 1).AddComment
'Insert The Image and Resize
CommentBox.Shape.Fill.UserPicture (PicturePath)
CommentBox.Shape.ScaleHeight 6, msoFalse, msoScaleFromTopLeft
CommentBox.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft
'Ensure Comment is Hidden (Swith to TRUE if you want visible)
CommentBox.Visible = False
Next i
' prompt message box show
MsgBox "Comments Added", vbInformation
End Sub
Code Explanation
ignore error if range blank go to next
On Error Resume Next
Defined Variable
Dim PicturePath As String
Dim CommentBox As Comment
Dim i, lastrow As Long
Defined Last Row
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Loop from row 2 to last row
For i = 2 To lastrow
Set Path With cells Ref loop
PicturePath = "C:\Users\imac\Desktop\Image\" & Cells(i, 1) & ".JPG"
existing comments clear
Cells(i, 1).ClearComments
Create a New Cell Comment
Set CommentBox = Cells(i, 1).AddComment
Insert The Picture and Resize
CommentBox.Shape.Fill.UserPicture (PicturePath)
CommentBox.Shape.ScaleHeight 6, msoFalse, msoScaleFromTopLeft
CommentBox.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft
Comment is Hidden (Switch to TRUE if you want visible)
CommentBox.Visible = False
Next Loop And Message box
Next i
' prompt message box show
MsgBox "Comments Added", vbInformation