CODEWITHSUNDEEP
excelvbacomments
Austin Wismer
Austin Wismer

Reputation: 281

Programmatically inserting pictures into cell comments

I'm trying to create a database in excel that includes images. The best way to do this seems to be to use a comment with the picture as the background of the comment. Unfortunately, I have around 100 observations, and this will be somewhat time consuming.

I'm very new to VBA. I know Python, and Matlab, but I'm just starting VBA.

Essentially, I need to:

  1. Create a comment for a given cell
  2. Remove any text from the commment
  3. Remove any line border from the comment
  4. resize the dimensions of the comment to width = 5 inches and height = 6.5 inches.
  5. fill the background with a specified image.

Now, all the images I need to use are in a specific folder. And I've included the filename in a call adjacent to the cell I'm trying to add the comment to.

So, I'm not exactly sure how to accomplish the above in VBA. I've started by recording a macro that yields some code which I modified to do the exact same thing with multiple cells. The only thing is, I need it to use a different image for the background for each comment. How might I accomplish this? It seems like I would need to set up some sort of a loop to go over all of the cells. Then, for the step to change the background, I would need to use the value next cell over to specify the location of the picture I want to use.

Unfortunately, my VBA skills are not quite up to this challenge. Any help would be much appreciated.

Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Option+Cmd+g


'    Range("C25:C50").AddComment
'    Range("C25:C50").Comment.Visible = False
'    Range("C25:C50").Comment.Shape.Select True
'    Range("C25:C50").Comment.Text Text:="" & Chr(13) & ""
'    Selection.ShapeRange.Line.Weight = 0.75
'    Selection.ShapeRange.Line.DashStyle = msoLineSolid
'    Selection.ShapeRange.Line.Style = msoLineSingle
'    Selection.ShapeRange.Line.Transparency = 0#
'    Selection.ShapeRange.Line.Visible = msoFalse
'    Selection.ShapeRange.Fill.Visible = msoTrue
'    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
'    Selection.ShapeRange.Fill.BackColor.RGB = RGB(251, 254, 130)
'    Selection.ShapeRange.Fill.Transparency = 0#
'    Selection.ShapeRange.Fill.UserPicture _
'        "OWC Mercury Extreme Pro:Users:austinwismer:Desktop:Flange:IMG_2626.JPG"
'    Selection.ShapeRange.LockAspectRatio = msoFalse
'    Selection.ShapeRange.Height = 468#
'    Selection.ShapeRange.Width = 360#
End Sub

Upvotes: 3

Views: 4233

Answers (1)

Cor_Blimey
Cor_Blimey

Reputation: 3310

The below demonstrates how to do it. Macro Recorder has given you 80% of required methods - all that was needed was some cleaning up (the recorder spits out a lot of junk) and changing some bits to method parameters.

The below shows a dialog to select your images then, starting with the Active Cell, progressively assigns each image to a cell comment as specified in your requirement.

'There are lots of ways to get teh filepaths. The below just demonstrate two ways.

Sub Example_UsingSelection()
    Dim cell As Range
    For Each cell In Selection
        SetCommentPicture cell.Offset(0, 1), cell.Value
    Next cell
End Sub

Sub Example_UsingFileDialog()
    Dim cell As Range
    Dim item

    Set cell = ActiveCell

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Select images"
        .ButtonName = "Select"
        .Show
        For Each item In .SelectedItems
            SetCommentPicture cell, CStr(item)
            Set cell = cell.Offset(1, 0)
        Next item
    End With

End Sub

Sub SetCommentPicture(cell As Range, imagePath As String)

    Dim cm As Comment

    'Get the comment
    If cell.Comment Is Nothing Then
        Set cm = cell.AddComment
    Else
        Set cm = cell.Comment
    End If

    'Clear any text
    cm.Text ""

    'Set comment properties (dimensions & picture)
    With cm.Shape
        .Width = Application.InchesToPoints(5)
        .Height = Application.InchesToPoints(6.5)
        .Line.Visible = msoFalse
        .Fill.UserPicture (imagePath)
    End With

End Sub

Upvotes: 2

Related Questions