Insert Picture To Cell in Col A with pic name in Col B

**EBTI** · 02-24-2011, 10:24 PM

Searched forum for two days and tried everything related to inserting pictures to get this to work. So, HELP! Please!

I have to file an insurance claim due to a fire in my home. I have a folder with .jpg photos located at C:\InsClaimOnlinePhotos\ . Im working with Excel 2003. I am trying to put the picture of the damaged protery in Column A on the same row as the detail about that damaged property using the ActiveSheet.Pictures.Insert function. The name of the picture is located in Column B. There are multiple sheets in the Excel book and each contains from 10 to over 700 rows. I would like to run the macro based on the active sheet to add the pictures one sheet at a time. I would like the pictures to be about 1.2" High by 1.6" Wide and be actually be within the cell of Column A of the row where the detail information is located. I have played with writing my own code, pieces of others code and full code sets I found in the Forum. Nothing works. Below is the best I found so far but, it uses Column C for the placement of the pictues.

When I try to run the below code I get Run-Time Error "1004" "Unable to get the insert Property of the Picture class".

I'm not sure if this code should work in Excel 2003 or not.

Thank you in advance for your help.

Here is the code:

Sub Picture()
'Assumptions
'1. picture names are found in col B starting at B2
'2. You want to paste each picture at different location
'3. where to paste the picture identified in col B, is found in col C starting at C2
 
 
 
 Dim picname As String
 Dim pasteAt As Integer
 Dim lThisRow As Long
 
    lThisRow = 2
 
    Do While (Cells(lThisRow, 2) <> "")
    
        pasteAt = Cells(lThisRow, 3)
        Cells(pasteAt, 1).Select 'This is where picture will be inserted
        
        picname = Cells(lThisRow, 2) 'This is the picture name
         
        ActiveSheet.Pictures.Insert("C:\InsClaimOnlinePhotos\" & picname & ".jpg").Select 'Path to where pictures are stored

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' This resizes the picture
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With Selection
            '.Left = Range("A6").Left
            '.Top = Range("A6").Top
            .Left = Cells(pasteAt, 1).Left
            .Top = Cells(pasteAt, 1).Top
            
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 100#
            .ShapeRange.Width = 80#
            .ShapeRange.Rotation = 0#
        End With
        
        lThisRow = lThisRow + 1
    
    Loop
    
    Range("A10").Select
    Application.ScreenUpdating = True
    
    Exit Sub
    
ErrNoPhoto:
    MsgBox "Unable to Find Photo" 'Shows message box if picture not found
    Exit Sub
    Range("B20").Select

End Sub

**davesexcel** · 02-25-2011, 05:11 AM

Hello,

What do you have in column C? it needs to be a number not a cell address. That was the only error I had when I ran the code.

**EBTI** · 02-25-2011, 12:31 PM

Ya, at first I had a cell address (A1) and received an error. When I changed it to a number (1) that error as resolved and debug moved to a new line. the new error is a Run-Time Error "1004" "Unable to get the insert Property of the Picture class". I found some reference online to the error being Microsoft file access flaw but, in playing with various code sets, I was able to pull in some pictures but the overstacked on eachother so, I know that's not the issue.

I'm thinking that the code runs in 2007 but, something is keeping it from working in 2003.

**EBTI** · 02-25-2011, 12:56 PM

OK ! Hold on a min. I just found an error in the path and fixed it. The picutes are loading into the Excel Sheet until a file is missing. Where a picture file is missing we get the error "1004". Totally logical. But, All the photos are stacking in onto of eachother in the top left corner of the sheet and not going into the the cell in Column A of the active row.

thanks for making me think harder! Now, I would appreciate help with the below two issues:

1. Placing an error message in the Macro that will state that a file is missing.

2. Fixing the macro so that the pictures load into the Cell of Column A for the active row. I have the number "1" in column C. Am I referencing the location to put the picture correctly? or is it a macro code issue?

In advance, Thank YOU! so much!

**EBTI** · 02-25-2011, 01:10 PM

I figured out that the number value in Column C is the Row position. But, the seem to be laying on top of the cells rather than inside the cells. If I change the hight of the row the Pictures slide up and overlap eachother as one would expect if they were contained in the cell. But, when I reduce the width of column A, the pictures remain in position and the text in Column B slides behind the photo, which indicates that the photo is laying on the cell and not within the cell. Is that just the way it is, or can that be fixted so that size of the cells in Column A dictates how much of the Picture can be viewed?

**e4excel** · 02-26-2011, 03:28 AM

Dear EBTI,

I have a NON_VBA Option which works fantastically, if you want please check the below link and the explantion a nd a file in the other thread:

http://www.excelforum.com/excel-prog...condition.html

Just for the readers to make it useful..

1. Create a list of Picture Names and Pictures Next to it in the adjoining column in a Sheet renamed as Picture Database
Ex:- Col A - Picture Name & Col B - Pictures.

2. Remove any Borders and Remove Gridlines in the above sheet..
Name - >
Code:

Picture =OFFSET('Picture DataBase'!$B$2,MATCH(Selection!$A$2,PictureList,0)-1,0,1,1)3. In any other sheet named Selection - create a simple dropdown with the List of all names as shown below:
Name - >
Code:
PictureList = OFFSET('Picture DataBase'!$A$2,0,0,COUNTA('Picture DataBase'!$A:$A),1)4. Select any cell with a Picture in it the Picture Database sheet and then click on the Camera Icon in Excel 2007 and then paste in the Selection sheet in a cell where you owuld like the dynamic pictures to appear and immediately rename it to Picture.. if you have de-clicked it please click again and the formula toolbar just add as =Picture and there you go..

5. Try selecting any other name and you would get a different picture for every selection..

Wow..So cool....

Regards
E

**davesexcel** · 02-26-2011, 08:24 AM

Use this bit of code to get the list of jpg files in the folder, then that part of the error would be eliminated.

Sub GetJPG()

    Dim y As Long

    Columns(2).ClearContents
    Range("B1") = "JPG Files"
    Application.ScreenUpdating = False
    
    With Application.FileSearch

        .LookIn = "C:\Documents and Settings\valued customer\My Documents\My Pictures\"    'Change to your location
        .FileType = msoFileTypeAllFiles

        For y = 1 To .FoundFiles.Count

            Sheet1.Cells(y + 1, 2) = Mid$(.FoundFiles(y), InStrRev(.FoundFiles(y), "\") + 1)

        Next

    End With

    OnlyJPG

End Sub
Sub OnlyJPG()
'Filters just jpg files
    Dim Rws As Long, Rng As Range

    Rws = Cells(Rows.Count, "B").End(xlUp).Row
    Set Rng = Range(Cells(2, 2), Cells(Rws, 2))

    Rng.AutoFilter Field:=1, Criteria1:="<>*.JPG*", Operator:=xlAnd
    Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete

End Sub

.JPG will still remain in the file name so that part of your original code would not be required.

**jolivanes** · 02-26-2011, 04:51 PM

Dave
Unfortunately your attachment does not work in 2007 (Application.Filesearch)
Good for 2003 though

Regards
John

**davesexcel** · 02-27-2011, 09:31 AM

Right then, give this a go.

Sub GetJPG()

    Dim Fldr As String
    Dim f As String
    Dim r As Long

    Fldr = "C:\Documents and Settings\valued customer\My Documents\My Pictures\"
    f = Dir(Fldr & "*.JP*")
    r = 2

    Columns(2).ClearContents
    Range("B1") = "JPG Files"

    Do While f <> ""

        Cells(r, 2) = f
        r = r + 1
        f = Dir()

    Loop
    
End Sub

**jolivanes** · 02-27-2011, 02:01 PM

That does the trick Dave.
Are you plowing snow too?

Thanks and Regards
John

**acraens** · 06-03-2014, 02:55 PM

How would i get this code working for excel 2010

**davesexcel** · 06-07-2014, 07:57 AM

Originally Posted by acraens

How would i get this code working for excel 2010

try this,

Sub Button1_Click()
    Dim fs, f, f1, fc, s
    Dim folderspec, r As Long

    folderspec = "C:\Users\Dave\Pictures\Family Pictures\Vince Morrison Child\"

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    r = 2

    For Each f1 In fc

        Cells(r, 2) = f1
        r = r + 1
    Next f1

End Sub

Insert Picture To Cell in Col A with pic name in Col B

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Conditional compilation arguments vba

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Re: Insert Picture To Cell in Col A with pic name in Col B

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions