Consulting

Results 1 to 20 of 20

Thread: EXCEL VBA to show images as comments

  1. #1
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location

    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

    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
    Last edited by Aussiebear; 02-21-2021 at 09:01 PM. Reason: Added code tags

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Please use code tags.

  3. #3
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    Hi - I'm a newbie to writing VBA. Could you explain what "Code Tags" are? Thank you!

  4. #4
    VBAX Expert Logit's Avatar
    Joined
    Sep 2016
    Posts
    606
    Location
    .
    CODE TAGS

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

  5. #5
    VBAX Expert Logit's Avatar
    Joined
    Sep 2016
    Posts
    606
    Location
    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
    Attached Files Attached Files

  6. #6
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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

  7. #7
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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?

  8. #8
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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 View Post
    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

  9. #9
    VBAX Expert Logit's Avatar
    Joined
    Sep 2016
    Posts
    606
    Location
    .
    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.

  10. #10
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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 View Post
    .
    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.

  11. #11
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  12. #12
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    I will try that. Thank you.

    Quote Originally Posted by SamT View Post
    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

  13. #13
    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
    Last edited by jolivanes; 02-11-2021 at 11:12 PM. Reason: extra info

  14. #14
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

  15. #15
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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

  16. #16
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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
    Quote Originally Posted by jolivanes View Post
    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

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

  18. #18
    VBAX Regular
    Joined
    Feb 2021
    Posts
    10
    Location
    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 View Post
    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.

  19. #19
    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.
    Last edited by jolivanes; 02-24-2021 at 03:35 PM.

  20. #20
    Did you get it to work?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •