EXCEL VBA to show images as comments

Hi-
I'm trying to write VBA to show images as comments for a list of item numbers.

1 - I have a file where the product images are saved that I'm referencing
2 - Some items are .png and some are .jpg - How do I write the code to look for either?
3 - If a product image is missing how do I make the code skip that product and look up the next one? (Right now the code stops when it hits a product that has no image)
4- I would like to set the size of the image as they're being distorted in the comment.

See below for how my code is written. Thank you in advance for your help. -KEEKS

Code:

---

Sub PictureToComments()
For Each cell In Range("a4:a100000")
        cell.AddComment
        cell.Comment.Text Text:=""
        cell.Comment.Visible = True
        cell.Comment.Shape.Select
        Selection.ShapeRange.Fill.UserPicture "G:\North America Sales\Products\Necklaces\Images" & cell.Value & ".png"
        cell.Select
        cell.Comment.Visible = False
Next
End Sub

---

Please use code tags.

Hi - I'm a newbie to writing VBA. Could you explain what "Code Tags" are? Thank you!

.
CODE TAGS

When replying with code, click on the # symbol in the menu bar. Place your code between the
[ CODE ] [ /CODE ] symbols.

Code:

---

Option Explicit

Sub InsertPictureComment()
'PURPOSE: Insert an Image into the ActiveCell's Comment
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault


Dim PicturePath As String
Dim CommentBox As Comment
Dim msoScaleFormTopLeft


'[OPTION 1] Explicitly Call Out The Image File Path
  'PicturePath = "C:\Users\chris\Desktop\Image1.png"


'[OPTION 2] Pick A File to Add via Dialog (PNG or JPG)
  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Title = "Select Comment Image"
    .ButtonName = "Insert Image"
    .Filters.Clear
    .Filters.Add "Images", "*.png; *.jpg"
    .Show
   
    'Store Selected File Path
      On Error GoTo UserCancelled
        PicturePath = .SelectedItems(1)
      On Error GoTo 0
    End With


'Clear Any Existing Comment
  Application.ActiveCell.ClearComments


'Create a New Cell Comment
Set CommentBox = Application.ActiveCell.AddComment


'Remove Any Default Comment Text
  CommentBox.Text Text:=""


'Insert The Image and Resize
  CommentBox.Shape.Fill.UserPicture (PicturePath)
  CommentBox.Shape.ScaleHeight 6, msoFalse, msoScaleFormTopLeft
  CommentBox.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft


'Ensure Comment is Hidden (Swith to TRUE if you want visible)
  CommentBox.Visible = False


Exit Sub


'ERROR HANDLERS
UserCancelled:


End Sub

---

Okay, Got it. Thanks!

Code:

---

Sub PictureToComments()

    For Each cell In Range("a4:a100000")
        cell.AddComment
        cell.Comment.Text Text:=""
        cell.Comment.Visible = True
        cell.Comment.Shape.Select
        Selection.ShapeRange.Fill.UserPicture "G:\North America Sales\Products\Necklaces\Images\" & cell.Value & ".png"
        cell.Select
        cell.Comment.Visible = False
       
        Next
       
End Sub

---

If I wanted to use this code, would I just need to replace the picture path with my picture path? How do I reference the range of cells I want to apply the code to?

If I wanted to use this code, would I just need to replace the picture path with my picture path? How do I reference the range of cells I want to apply the code to?

Quote:

---

Originally Posted by Logit

Code:

---

Option Explicit

Sub InsertPictureComment()
'PURPOSE: Insert an Image into the ActiveCell's Comment
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault


Dim PicturePath As String
Dim CommentBox As Comment
Dim msoScaleFormTopLeft


'[OPTION 1] Explicitly Call Out The Image File Path
  'PicturePath = "C:\Users\chris\Desktop\Image1.png"


'[OPTION 2] Pick A File to Add via Dialog (PNG or JPG)
  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Title = "Select Comment Image"
    .ButtonName = "Insert Image"
    .Filters.Clear
    .Filters.Add "Images", "*.png; *.jpg"
    .Show
   
    'Store Selected File Path
      On Error GoTo UserCancelled
        PicturePath = .SelectedItems(1)
      On Error GoTo 0
    End With


'Clear Any Existing Comment
  Application.ActiveCell.ClearComments


'Create a New Cell Comment
Set CommentBox = Application.ActiveCell.AddComment


'Remove Any Default Comment Text
  CommentBox.Text Text:=""


'Insert The Image and Resize
  CommentBox.Shape.Fill.UserPicture (PicturePath)
  CommentBox.Shape.ScaleHeight 6, msoFalse, msoScaleFormTopLeft
  CommentBox.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft


'Ensure Comment is Hidden (Swith to TRUE if you want visible)
  CommentBox.Visible = False


Exit Sub


'ERROR HANDLERS
UserCancelled:


End Sub

---

---

.
If you have more than one image, choose OPTION 2.

That will present the FILE MANAGER window from which you can select which image should be placed in a specific cell.
Then you can run the macro again and select a different image for another cell ... etc. etc.

If there is only one image, you could choose OPTION 1 and hard code the path to the image but why would you ? It is
easier simply to select OPTION 2.

I have at least 100 product numbers, so I will have to select the file for each one? Is there a work around? The code I posted, did that for me, it just stopped working when it came across a product number that wasn't in the folder or that was saved as a Jpg. I want to have the code skip those instances and go to the next cell.

Quote:

---

Originally Posted by Logit

.
If you have more than one image, choose OPTION 2.

That will present the FILE MANAGER window from which you can select which image should be placed in a specific cell.
Then you can run the macro again and select a different image for another cell ... etc. etc.

If there is only one image, you could choose OPTION 1 and hard code the path to the image but why would you ? It is
easier simply to select OPTION 2.

---

Well, that is a new question than your original post

use On Error

Code:

---


'For X in Y
  On Error GoTo Skippit

  'some lines of code

Skippit:

  'Maybe some more lines of code
 
Next X

---

I will try that. Thank you.

Quote:

---

Originally Posted by SamT

Well, that is a new question than your original post

use On Error

Code:

---


'For X in Y
  On Error GoTo Skippit

  'some lines of code

Skippit:

  'Maybe some more lines of code
 
Next X

---

---

I was under the impression that you wanted something like this.
If so, change references as and where required.
The Cells in Column A need the filename without path and file extension.

Code:

---

Sub Maybe_Try_So()
Dim PicturePath As String
Dim CommentBox As Comment
Dim i As Long
Dim fn


    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row    '<---- Change the 1 to the first cell in Column A with a file name without extension
    fn = Dir("C:\Folder Name 1\Folder Name 2\Folder Name 3\" & Range("A" & i).Value & ".*")    '<---- Change to actual Folder(s)
        If Len(Dir("C:\Folder Name 1\Folder Name 2\Folder Name 3\" & Range("A" & i).Value & ".*", vbDirectory)) <> 0 Then    '<---- Change to actual Folder(s)
            PicturePath = fn
            Application.Range("A" & i).ClearComments
                Set CommentBox = Application.Range("A" & i).AddComment
                CommentBox.Text Text:=""
                CommentBox.Shape.Fill.UserPicture (PicturePath)
                CommentBox.Shape.Height = 20    '<---- Set size or use the AutoSize
                CommentBox.Shape.Width = 20    '<---- Set size or use the AutoSize
                'CommentBox.Shape.TextFrame.AutoSize = True
                CommentBox.Visible = False
            Else
        End If
    Next i
End Sub

---

Code:

---

Sub M_snb()
  On Error Resume Next
  c00 = "G:\OF\"
 
  For Each it In Sheet1.Columns(1).SpecialCells(2)
    If Dir(c00 & it & "*.jpg") <> "" Then it.AddComment.Shape.Fill.UserPicture c00 & it & ".jpg"
    If Err.Number <> 0 Then it.Comment.Shape.Fill.UserPicture c00 & it & ".jpg"
    Err.Clear
  Next
End Sub

---

Hi - I tried this changing what I needed as per your direction but when I run the Macro I get an error "The specified file wasn't found" .

"CommentBox.Shape.Fill.UserPicture (PicturePath)" highlights when I hit debug.

Here's my revised code based on your suggestion. Thank you in advance for your help on this!

Code:

---

Sub PicComments()Dim PicturePath As String
Dim CommentBox As Comment
Dim i As Long
Dim fn




    For i = 17 To Cells(Rows.Count, 17).End(xlUp).Row    '<---- Change the 1 to the first cell in Column A with a file name without extension
    fn = Dir("C:\North America Sales\Products\Jewelry\Images\" & Range("C" & i).Value & ".*")    '<---- Change to actual Folder(s)
        If Len(Dir("C:\North America Sales\Products\Jewelry\Images\" & Range("C" & i).Value & ".*", vbDirectory)) <> 0 Then    '<---- Change to actual Folder(s)
            PicturePath = fn
            Application.Range("C" & i).ClearComments
                Set CommentBox = Application.Range("C" & i).AddComment
                CommentBox.Text Text:=""
                CommentBox.Shape.Fill.UserPicture (PicturePath)
                CommentBox.Shape.Height = 20    '<---- Set size or use the AutoSize
                CommentBox.Shape.Width = 20    '<---- Set size or use the AutoSize
                'CommentBox.Shape.TextFrame.AutoSize = True
                CommentBox.Visible = False
            Else
        End If
    Next i
End Sub

---

Hi - I tried this changing what I needed as per your direction but when I run the Macro I get an error "The specified file wasn't found" .

"CommentBox.Shape.Fill.UserPicture (PicturePath)" highlights when I hit debug.

Here's my revised code based on your suggestion. Thank you in advance for your help on this!

Code:

---

Sub PicComments()Dim PicturePath As String
Dim CommentBox As Comment
Dim i As Long
Dim fn




    For i = 17 To Cells(Rows.Count, 17).End(xlUp).Row    '<---- Change the 1 to the first cell in Column A with a file name without extension
    fn = Dir("C:\North America Sales\Products\Jewelry\Images\" & Range("C" & i).Value & ".*")    '<---- Change to actual Folder(s)
        If Len(Dir("C:\North America Sales\Products\Jewelry\Images\" & Range("C" & i).Value & ".*", vbDirectory)) <> 0 Then    '<---- Change to actual Folder(s)
            PicturePath = fn
            Application.Range("C" & i).ClearComments
                Set CommentBox = Application.Range("C" & i).AddComment
                CommentBox.Text Text:=""
                CommentBox.Shape.Fill.UserPicture (PicturePath)
                CommentBox.Shape.Height = 20    '<---- Set size or use the AutoSize
                CommentBox.Shape.Width = 20    '<---- Set size or use the AutoSize
                'CommentBox.Shape.TextFrame.AutoSize = True
                CommentBox.Visible = False
            Else
        End If
    Next i
End Sub

---

Quote:

---

Originally Posted by jolivanes

I was under the impression that you wanted something like this.
If so, change references as and where required.
The Cells in Column A need the filename without path and file extension.

Code:

---

Sub Maybe_Try_So()
Dim PicturePath As String
Dim CommentBox As Comment
Dim i As Long
Dim fn


    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row    '<---- Change the 1 to the first cell in Column A with a file name without extension
    fn = Dir("C:\Folder Name 1\Folder Name 2\Folder Name 3\" & Range("A" & i).Value & ".*")    '<---- Change to actual Folder(s)
        If Len(Dir("C:\Folder Name 1\Folder Name 2\Folder Name 3\" & Range("A" & i).Value & ".*", vbDirectory)) <> 0 Then    '<---- Change to actual Folder(s)
            PicturePath = fn
            Application.Range("A" & i).ClearComments
                Set CommentBox = Application.Range("A" & i).AddComment
                CommentBox.Text Text:=""
                CommentBox.Shape.Fill.UserPicture (PicturePath)
                CommentBox.Shape.Height = 20    '<---- Set size or use the AutoSize
                CommentBox.Shape.Width = 20    '<---- Set size or use the AutoSize
                'CommentBox.Shape.TextFrame.AutoSize = True
                CommentBox.Visible = False
            Else
        End If
    Next i
End Sub

---

---

Get us a few examples of the file names in the folder as well as a few examples of what you have in Column C

Everything works like a dandy here.

Code:

---

For i = 17 To Cells(Rows.Count, 17).End(xlUp).Row

---

Should that not be

Code:

---

For i = 17 To Cells(Rows.Count, 3).End(xlUp).Row

---

If your comments and names are in Column C

Otherwise attach your workbook without sensitive data.

The file names are product numbers for example 180548.png, 180549.png, 180550.png and so on. In column "C" I have the product numbers listed 180548, 180549, 180550, and so on. For example, The complete picture file path would be C:\North America Sales\Products\Necklaces\Images\180548.png.

I hope this explains better. If not I will try and add the file.

Thanks again!

Quote:

---

Originally Posted by jolivanes

Get us a few examples of the file names in the folder as well as a few examples of what you have in Column C

Everything works like a dandy here.

Code:

---

For i = 17 To Cells(Rows.Count, 17).End(xlUp).Row

---

Should that not be

Code:

---

For i = 17 To Cells(Rows.Count, 3).End(xlUp).Row

---

If your comments and names are in Column C

Otherwise attach your workbook without sensitive data.

---

Don't quote unless absolutely necessary, which I have never seen yet. Just a bunch of not needed clutter. Refer to a Post number or a helper's name if needed.
Did you change the 17 to a 3 as suggested?
You show all png files now. Is that what they are or mixed as mentioned in Post #1?

And do your comments start at Cell C17?
The way you changed it, you start at Cell Q17.

Did you get it to work?