Using VBA To Add An Image Into Cell’s Comment

Excel Add Image To Cell Comment

        We created a macro to add the selected image to the cell comment.
When button in the sheet is clicked ,the macro  will open the dialog box to select image file , the user selects a picture, then an input box asks for the percent of scaling to apply to display of the picture. 

The picture will be inserted into the comment box of the currently selected cell. The picture will popup from the worksheet when the mouse hovers over the cell just as a normal comment would.

        We added a button to the worksheet to run the macro. However, the macro can also be run from different ways . In the "Macro" window opened by pressing Alt + F8 keys, the macro named "add_content_image" is selected and the "Run" button is pressed.

Codes of macro:

Sub add_content_image()
Dim myFile As FileDialog, ImgFile, myImg As Variant, ZoomF As String
On Error Resume Next

Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
.Filters.Add Description:="Images", Extensions:="*.jpg,*.Jpg,*.gif,*.png,*.tif,*.bmp", Position:=1
If .Show <> -1 Then
MsgBox "No image selected", vbCritical
Exit Sub
End If
End With

  ImgFile = myFile.SelectedItems(1)
  If ImgFile = False Then Exit Sub
Application.ScreenUpdating = False
  ZoomF = InputBox(Prompt:="Your selected file path:" & _
    vbNewLine & ImgFile & _
    vbNewLine & "" & _
    vbNewLine & "Input zoom % factor to apply to picture?" & _
    vbNewLine & "(Original picture size equals 100) ." & _
    vbNewLine & "Input a number greater than zero!", Title:="Picture Scaling Percentage Factor", Default:=100)
    
    If Not IsNumeric(ZoomF) Or ZoomF = 0 Or ZoomF = "" Then
MsgBox "You must enter a valid numeric value. Entered value must be a number greater than zero." & _
    vbNewLine & "Macro will terminate.", vbCritical
Exit Sub
End If
With ActiveCell
.ClearComments
.AddComment
.Interior.ColorIndex = 19
End With

 Set myImg = LoadPicture(ImgFile)
  With ActiveCell.Comment
    .Shape.Fill.UserPicture ImgFile
    .Shape.Width = myImg.Width * ZoomF / 2645.9
    .Shape.Height = myImg.Height * ZoomF / 2645.9
  End With
    Application.ScreenUpdating = True
    Set myFile = Nothing: Set myImg = Nothing
End Sub