Thanks Thanks:  0
Likes Likes:  0
Results 1 to 4 of 4

Thread: Email image from lookup

  1. #1
    New Member
    Join Date
    Jan 2010
    Posts
    29
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Email image from lookup

    Hi

    I have posted this before but had no joy, so I am reposting hoping to resolve.

    I have the following code that looks up an image based on the text in the cells in column A, this look-up the image and places it in column L. The problem is when I email the file the images disappear. Is there any way to ensure that the images are kept in the sheet?

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myPict As Picture
    Dim PictureLoc As String
    Dim lr As Long, r As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row

    ActiveSheet.Pictures.Delete
    For r = 2 To lr
    PictureLoc = "C\photography" & Range("A" & r).Value & ".jpg"

    With Range("l" & r)
    Set myPict = ActiveSheet.Pictures.AddPicture(PictureLoc)
    .RowHeight = 144
    myPict.Top = .Top
    myPict.Left = .Left
    myPict.Width = 110
    myPict.Height = 140


    myPict.Placement = xlMoveAndSize
    End With

    Next r
    End Sub

    Thanks in advance.

  2. #2
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    18,501
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    4 Thread(s)

    Default Re: Email image from lookup

    Try using the AddPicture method of the Shapes object instead. By the way, I noticed that you're missing a colon in your assigned path. Also, I'm guessing that "photography" is the name of your folder, not part of the filename. If so, you're also missing a backslash (\). So maybe something like this...

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Dim myPict As Shape
        Dim PictureLoc As String
        Dim lr As Long, r As Long
        
        lr = Cells(Rows.Count, "A").End(xlUp).Row
        
        ActiveSheet.Pictures.Delete
        
        For r = 2 To lr
            PictureLoc = "C:\photography\" & Range("A" & r).Value & ".jpg"
            With Range("l" & r)
                .RowHeight = 144
                Set myPict = ActiveSheet.Shapes.AddPicture(Filename:=PictureLoc, _
                    LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=110, Height:=140)
                myPict.Placement = xlMoveAndSize
            End With
        Next r
        
    End Sub
    Hope this helps!

  3. #3
    New Member
    Join Date
    Jan 2010
    Posts
    29
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Email image from lookup

    Thank you for your response.

    I get the 1004 error message file not found! The jpeg file is there and named the same with caps. The debug highlights "Set myPict = ActiveSheet.Shapes.AddPicture(Filename:=PictureLoc, _ LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=110, Height:=140)"

    I have no idea how to fix this.

  4. #4
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    18,501
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    4 Thread(s)

    Default Re: Email image from lookup

    Maybe the path is incorrect? If you run it again, when you get that same error, move your cursor over the variable PictureLoc. Is it a valid path and filename that is displayed? What string has been assigned to it?

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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