Skip to content 
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 
