Insert pictures as a note with macro

[Akos]

Hello, Is there any macro what can insert pictures (jpg; jpeg) into note section in excel?
The best could be that, the macro can insert it into any column's note section (so not just an exact column) and also create the note for the insert.
If there is a macro for this, after the insert process, can I somehow compress the pictures?

I attached an example about what I mean. (Here you can't see but column B also has a note section and the picture there, thats why I need the macro with any column)

 

[Akos]

Anyone please?

 

[NdNoviceHlp]

Hi Akos. I suspect that the lack of replies is because "notes" are actually comments. If you google pictures in comments there's lots of stuff. Here's some sample code...

With Activesheet.Range("B" & 1)
        .AddComment
        .Comment.Text Text:="Picture Name:" & Chr(10) & ""
        .Comment.ShapeRange.Fill.UserPicture "C:\Users\Owner\Pictures\YourPictureFile.jpg"
End With

HTH. Dave

 

[Akos]

Hello Dave, thank you for reply, I was not very detailed about what i want. So basically I need a macro to insert pictures in comment to any column from Row2. (if its easier its ok with column "A" but pls tell me what should i modify in the code to make it work on another column)

The pictures are on my desktop here: C:\Users\szaboako\Desktop\Macro test

The pictures named exactly the same as the column value where I need the pictures in the comment. So firstly I think it needs to find the active column's value in the folder then insert the comment with the picture. (jpg/jpeg file)

It could be awesome, if the macro won't find in this folder the value, just simply goes to the next value in the column and continue the insert process
And i dont know if its possible, but I need the pictures compressed in "web" type (150ppi)

I hope you can help me, and sorry but i'm not so expert in macro codes.

 

[NdNoviceHlp]

Hi Akos. Where are the picture names (sht name, rows and columns)? What kind of pic files ie. JPG, Gif etc. ? Seems like it's possible to load the comments with pics. Do you want all the comments filled at once? I'm not familiar with what pictures compressed in "web" type means or if it can be done. Maybe others will be able to help with that. Dave

 

[Akos]

Hi Dave,
Picture names: Is it possible to write in macro the active sheet,column,row? I mean the picture names are usually in other column in different files. For example for one file its in column "A", in the next file its in column "H" etc.

Picture kind: only JPG

Comments: It could be cool to fill all at once, but its also ok after eachother but automatically

With "web" compress I mean that part when you click on a picture in excel and on "Picture format" there is a menu for "Picture Compress" where you can modify the picture resolution to some category like email,web,print etc. If its not possible with the macro its ok, the main thing is for me to be able to upload in comments the pictures.

 

[NdNoviceHlp]

Akos you need to specify exactly where the picture names are for each comment (columns & rows). VBA code is not psychic,,,, it can't tell what cells are picture names (unless you have a file extension in these cells ie. .JPG?). It is possible to code a sheet change event for the active cell but every time a different cell is selected, the contents of the file folder would have to be searched to see if the cell contained a file name... very cumbersome and doomed to fail. Dave

 

[Akos]

Okey, then could you please code it to Column "A"? I can't specify the row numbers, I attached an example, you can see now a few product numbers in Column "A", and I have pictures (JPG) in this folder with the exact same name like the product names in column "A" : C:\Users\szaboako\Desktop\Macro test. And I need the macro to put the picture in comment to these product names in column "A". (If you tell me what should I change in the macro to make it work for example in column "B","H","E" etc, I can change it for future works)
And the problem is that I can't tell how many rows will be needed as all files which contains product name are different length.

Sorry If I missunderstood something, but I hope I gave the info what you needed.

 

[NdNoviceHlp]

Akos you can give this a trial. HTH. Dave

Sub InsertPicComment()
Dim SFolder As Object, FSO As Object
Dim sFileName As Object, ArrPath() As Variant, Cnt As Integer, Cnt2 As Integer
Dim ArrName() As Variant, ofsobj As Object, Cnt3 As Integer, LastRow As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")
'*** Folder path Change as needed
Set SFolder = FSO.GetFolder("C:\Users\szaboako\Desktop\Macro test\")

'Loop through each file in a folder.
'Load name & path to arrays
For Each sFileName In SFolder.Files
Cnt = Cnt + 1
ReDim Preserve ArrName(Cnt)
ReDim Preserve ArrPath(Cnt)
ArrName(Cnt - 1) = Left(sFileName.Name, Len(sFileName.Name) - 4)
ArrPath(Cnt - 1) = sFileName.Path
Next sFileName

With Sheets("Sheet1")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'match "A" name with file name
'loop rows
For Cnt2 = 2 To LastRow
'loop file names
For Cnt3 = LBound(ArrName) To UBound(ArrName) - 1
If LCase(Sheets("Sheet1").Range("A" & Cnt2).Value) = LCase(ArrName(Cnt3)) Then
With Sheets("Sheet1").Range("A" & Cnt2)
'delete previous comment
If Not .Comment Is Nothing Then
.Comment.Delete
End If
.AddComment
.Comment.Text Text:="Picture Name:" & Chr(10) & ""
.Comment.Shape.Fill.UserPicture ArrPath(Cnt3)
'****adjust to suit
.Comment.Shape.ScaleHeight 6, msoFalse, msoScaleFromTopLeft
.Comment.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft
End With
Exit For
End If
Next Cnt3
Next Cnt2

Set SFolder = Nothing
Set FSO = Nothing
End Sub

edit: Oddly enough, a right click on the cell with the comment pic no longer has comment edit ... it has Note edit

 

[NdNoviceHlp]

This is better. Dave

Sub InsertPicComment()
Dim SFolder As Object, FSO As Object, Flag As Boolean
Dim sFileName As Object, ArrPath() As Variant, Cnt As Integer, Cnt2 As Integer
Dim ArrName() As Variant, ofsobj As Object, Cnt3 As Integer, LastRow As Integer

Set FSO = CreateObject("Scripting.FileSystemObject")
'*** Folder path Change as needed
Set SFolder = FSO.GetFolder("C:\Users\szaboako\Desktop\Macro test\")

'Loop through each file in a folder.
'Load name & path to arrays
For Each sFileName In SFolder.Files
Cnt = Cnt + 1
ReDim Preserve ArrName(Cnt)
ReDim Preserve ArrPath(Cnt)
ArrName(Cnt - 1) = Left(sFileName.Name, Len(sFileName.Name) - 4)
ArrPath(Cnt - 1) = sFileName.Path
Next sFileName

With Sheets("Sheet1")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'match "A" name with file name
'loop rows
For Cnt2 = 2 To LastRow
'loop file names
Flag = False
For Cnt3 = LBound(ArrName) To UBound(ArrName) - 1
If LCase(Sheets("Sheet1").Range("A" & Cnt2).Value) = LCase(ArrName(Cnt3)) Then
    With Sheets("Sheet1").Range("A" & Cnt2)
    'delete previous comment
        If Not .Comment Is Nothing Then
        .Comment.Delete
        End If
    .AddComment
    .Comment.Text Text:="Picture Name:" & Chr(10) & Sheets("Sheet1").Range("A" & Cnt2).Value
    .Comment.Shape.Fill.UserPicture ArrPath(Cnt3)
    '****adjust to suit
    .Comment.Shape.ScaleHeight 6, msoFalse, msoScaleFromTopLeft
    .Comment.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft
    Flag = True
    Exit For
    End With
End If
Next Cnt3
If Not Flag Then
    If Not Sheets("Sheet1").Range("A" & Cnt2).Comment Is Nothing Then
    Sheets("Sheet1").Range("A" & Cnt2).Comment.Delete
    End If
End If
Next Cnt2

Set SFolder = Nothing
Set FSO = Nothing
End Sub

ps. It seems that pics are inserted as notes as there are no comments to "Review" after running this code but there are notes to "Review"