Consulting

Results 1 to 8 of 8

Thread: Import image from path in adjacent cell

  1. #1

    Import image from path in adjacent cell

    I have been working on the below to bring an image into Column A where the full file path to the .jpg exists in Column B.
    Other values may also exist in Column B so I want to check that the path is valid. When it is I want to import the image and when it isn't valid I want to move to the next cell.

    I've found that the code works when selecting single cells and even 2 cells, but 3 or more in the range and it fails by generating a 1004 runtime error.

    'macro that will insert an image in a selected range based on the path.jpg in the column to the right
    
    Sub InsertPic()
    
    'set some parameters
    Dim Pic As String 'file path of pic
    Dim myPicture As Picture 'embedded pic
    Dim rng As Range 'range over which we will iterate
    Dim cl As Range 'iterator
    Dim FileName As String 'for checking if file exists
    
    'use the user selected cells as the selection range
    Set rng = Selection
    
    'look in the cell to the right for the image value
    For Each cl In rng
        Pic = cl.Offset(0, 1)
    
    'set a filename for the image link in the adjacent cell
    'check if the filename is valid
    'if it isn't valid move down to "NextRow" which is towards the bottom of this macro
       
       On Error GoTo NextRow:
       FileName = VBA.FileSystem.Dir(Pic)
        If FileName <> VBA.Constants.vbNullString Then
        
    'if no errors found and the filename is valid then import the image and set dimensions
    
            Set myPicture = ActiveSheet.Pictures.Insert(Pic)
    
                With myPicture
                    .ShapeRange.LockAspectRatio = msoTrue
                    .Height = 150
                    '.Width = cl.Width
                    .Top = Rows(cl.Row).Top + 4
                    .Left = Columns(cl.Column).Left + 4
                    cl.RowHeight = myPicture.Height + 4
                    'cl.ColumnWidth = myPicture.Width + 4
                    LinkToFile = msoFalse
                    SaveWithDocument = msoTrue
                End With
            
    Else
        End If
    
    NextRow:
    'move to the next cell
    Next
    
    End Sub
    It feels like I'm very close to the solution but have spent a good few hours trying to get to a point where it's error free and have failed. Any help really appreciated!!
    Last edited by Paul_Hossler; 06-30-2022 at 05:07 PM. Reason: Changed QUOTE tags to CODE tags

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,580
    Any sample file too.

  3. #3
    Quote Originally Posted by snb View Post
    Any sample file too.
    I donít have a file handy but this should give you an idea of the format. I want users to be able to select cells in column A and run the macro to bring images from Column B into the cell.

    Column A
    where I want the picture
    Column B
    File path
    Notes
    \\data\folder\example.jpg This image exists so I want to import into column A
    Blank cell in column B so do nothing
    Blank cell in column B so do nothing
    \\data\folder\example_2.jpg This file doesnít exist in the folder so do nothing
    Blank cell in column B so do nothing

    Thanks!

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,580
    You are drifting away from a solution as long as I don't see a sample Excel file.

  5. #5
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    814
    Location
    Give the below a try, it looks at the filepaths in column B:
    Sub test()    
        Dim img As Picture
        Dim rng As Range
        Dim rCell As Range, iRng As Range
        
        ' the below sets the range to all of the file paths that exist in column B
        Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants)
        
        On Error Resume Next ' will help us ignore images that do not exist, switch errors off
            For Each rCell In rng.Cells ' loop through the range set above
                Set img = ActiveSheet.Pictures.Insert(rCell.Value) ' looking at the filepath in column B
                Set iRng = rCell.Offset(, -1) ' set a range to the cell where the image is to be placed
                With img
                   .Left = iRng.Left
                   .Top = iRng.Top
                   .Width = iRng.Width
                   .Height = iRng.Height
                   .Placement = xlMoveAndSize ' how the image is placed (floating, move and size etc...)
                   .PrintObject = True ' yes or no to print the object
                End With
                Set img = Nothing ' clear the image in case the next image is missing
            Next rCell
        On Error GoTo 0 ' turn errors back on
    End Sub
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

  6. #6
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,182
    Location
    Being able to receive assistance is clearly graded ( in terms of usefulness) up the following:

    1.an example file, ( Very good)
    2.a distinct explanation ( sometimes good but misses critical points)
    3.an image ( poor as it lacks the real detail, as images don't expand well enough to show the real detail)
    4. rambling text ( most people will simply pass it by)

    its your approach but in Post #3 you haven't really helped anyone to "want" to assist you. Being precise as possible is an advantage.

    with that in mind, how is VBA meant to read a JPG image in a cell?
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    Quote Originally Posted by georgiboy View Post
    Give the below a try, it looks at the filepaths in column B:
    Sub test()    
        Dim img As Picture
        Dim rng As Range
        Dim rCell As Range, iRng As Range
        
        ' the below sets the range to all of the file paths that exist in column B
        Set rng = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeConstants)
        
        On Error Resume Next ' will help us ignore images that do not exist, switch errors off
            For Each rCell In rng.Cells ' loop through the range set above
                Set img = ActiveSheet.Pictures.Insert(rCell.Value) ' looking at the filepath in column B
                Set iRng = rCell.Offset(, -1) ' set a range to the cell where the image is to be placed
                With img
                   .Left = iRng.Left
                   .Top = iRng.Top
                   .Width = iRng.Width
                   .Height = iRng.Height
                   .Placement = xlMoveAndSize ' how the image is placed (floating, move and size etc...)
                   .PrintObject = True ' yes or no to print the object
                End With
                Set img = Nothing ' clear the image in case the next image is missing
            Next rCell
        On Error GoTo 0 ' turn errors back on
    End Sub
    Thank you so much! This has really helped me out.

    I've adapted it slightly below to use a user selected range for "Set Rng". Eg they select there they want images to land and then it checks the neighbouring cell for the values. I've not been able to re-work the SpecialCells element into the user selected range. Is this important?

    Thanks again!!

    Sub insertpic()
        Dim img As Picture
        Dim rng As Range
        Dim rCell As Range, iRng As Range
        
        ' the below sets the range to all of the file paths that exist in column B
        Set rng = Selection.Offset(0, 1).SpecialCells(xlCellTypeConstant)
        
        
        On Error Resume Next ' will help us ignore images that do not exist, switch errors off
            For Each rCell In rng.Cells ' loop through the range set above
                Set img = ActiveSheet.Pictures.Insert(rCell.Value) ' looking at the filepath in column B
                Set iRng = rCell.Offset(, -1) ' set a range to the cell where the image is to be placed
                With img
                   .Left = iRng.Left + 4
                   .Top = iRng.Top + 4
                   .Width = iRng.Width
                   '.Height = iRng.Height
                   .Height = 150
                   iRng.RowHeight = img.Height + 8
                   .ShapeRange.LockAspectRatio = msoTrue
                   .Placement = xlMove ' how the image is placed (floating, move and size etc...)
                   .PrintObject = True ' yes or no to print the object
                    LinkToFile = msoFalse
                    SaveWithDocument = msoTrue
                End With
                Set img = Nothing ' clear the image in case the next image is missing
            Next rCell
        On Error GoTo 0 ' turn errors back on
    End Sub

  8. #8
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    814
    Location
    Glad it helped, the special cells part will skip over the blank cells in the range set. This means it should only loop through the cells in that range that contain a constant. Effectively it should only loop through the cells in the range that contain a filepath.

    The attached may help understand the specialcells function.
    Attached Files Attached Files
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

Tags for this Thread

Posting Permissions

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