EXCEL VBA to show images as comments

[keeks]

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


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

[snb]

Please use code tags.

[keeks]

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

[Logit]

.
CODE TAGS

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

[Logit]

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

[keeks]

Okay, Got it. Thanks!


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

[keeks]

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?

[keeks]

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?




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

[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.

[keeks]

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.


.
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.

[SamT]

Well, that is a new question than your original post

use On Error


'For X in Y
On Error GoTo Skippit

'some lines of code

Skippit:

'Maybe some more lines of code

Next X

[keeks]

I will try that. Thank you.


Well, that is a new question than your original post

use On Error


'For X in Y
On Error GoTo Skippit

'some lines of code

Skippit:

'Maybe some more lines of code

Next X

[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.


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

[snb]

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

[keeks]

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!


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

[keeks]

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!


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





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.


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

[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.


For i = 17 To Cells(Rows.Count, 17).End(xlUp).Row
Should that not be

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.

[keeks]

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!



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.


For i = 17 To Cells(Rows.Count, 17).End(xlUp).Row
Should that not be

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.

[jolivanes]

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.

[jolivanes]

Did you get it to work?