There's no such thing as a stupid question, but they're the easiest to answer.
JoinTour
Login
Search
Business Applications
Tag Cloud
access acer asus bios bsod computer crash desktop driver drivers error ethernet excel freeze gaming hard drive hardware hdmi internet laptop malware memory modem monitor motherboard netgear network printer problem ram registry repair router slow software sound toshiba trojan usb video virus vista wifi windows windows 7 windows 7 32 bit windows 7 64 bit windows xp wireless xbox
Search
Search for:
Tech Support Guy Forums > Software & Hardware > Business Applications >
Solved: Need help adding images to excel (dynamically)

Reply  
Thread Tools
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
22-Oct-2009, 10:41 PM #1
Solved: Need help adding images to excel (dynamically)
Hi all,

I'm a newbie here so I appreciate any help that is offered. I searched around the forum here a bit, but could not find anything matching my exact needs (similar posts used combo boxes or just needed a single picture... not quite what I need)

I'm trying to create a product catalog for a client.
The product info is stored on a database and is being pulled into excel via an excel ODBC Query. One of the fields is the image name (product01.jpg, product02.jpg, etc..). The images are stored on the hard drive. The list of products will be different everytime depending on what the user filters in the query.

I need to be able to include the images in the product list.
Sample fields are ProductId, ProductName, ProductCost, ProductImage.
I'm guessing this will need VBA code to work. I'm not familiar with VBA coding, but with some help I'm sure I can get it working. Ideally, the pictures should show up as 125x125 pixels and the rowhight for each row should match the image hight.

All this needs to be dynamic as one time the query might return 10 rows, and another time 150 rows.

Running Windows XP with Excel 2003.

Any help is appreciated!
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
26-Oct-2009, 10:22 PM #2
bump
Aj_old's Avatar
Computer Specs
Senior Member with 869 posts.
 
Join Date: Sep 2007
Location: Moldova
Experience: Intermediate
27-Oct-2009, 10:38 AM #3
Hi and welcome to forum.
First I think it would be easier done in Access - as it's more suitable for such things.
Second if you need it done in excel we would need more info:
1. are the images stored in the same folder?
2. does the query return the full name (name with extension and the path?
3. the excel file is already opened or it need to be opened?
__________________
“I hear, I know. I see, I remember. I do, I understand.” (Confucius 551 BC – 479)
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
28-Oct-2009, 11:35 PM #4
Hi,

Thanks for taking the time to respond.

As I mentioned, I'm trying to create this for a client and they said they want it in excel... so that's what I have to stick with, even if it's harder to do it that way

1. Just to clarify... Are the images stored in the same folder as what? Same folder as the excel file? Ideally the user should be able to open up Excel from his desktop shortcut and run the report (images are not stored on desktop).

2. The query returns just the file name and extension. the path is not returned.

3. I'm not sure if I understood your 3rd question. The way the report should work is that the user opens a blank excel sheet and runs the odbc query. Excel would then pull in the pictures automatically based on the picture name that was returned from the query. If the user decides to then take that excel file that's already open and re-run the query with different parameters, it should work as well (update the pictures based on the new results).

Hope that all made sense.
Let me know if you have any other questions for me.

I appreciate your help!
Aj_old's Avatar
Computer Specs
Senior Member with 869 posts.
 
Join Date: Sep 2007
Location: Moldova
Experience: Intermediate
29-Oct-2009, 04:25 PM #5
Try this codes.
Code:
Sub InsertPictures()
    col = "B" 'Change the column letter to corespond to the column where the filenames are stored
    nr_pictures = ActiveSheet.Cells(65356, col).End(xlUp).Row
    pict_path = ThisWorkbook.Path & "\"
    
    For i = 2 To nr_pictures 'If your data do not stat with row 2, change i=2 to the coresponding value
        InsertPicture pict_path & Cells(i, col).Value, Cells(i, col)
    Next
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)


    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        .ColumnWidth = 20
        .RowHeight = 93.75
    End With
    
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
    
    ' resize picture
    With p
        .Width = Application.CentimetersToPoints(3.3)
        .Height = Application.CentimetersToPoints(3.3)
    End With
    
    Set p = Nothing
End Sub
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
01-Nov-2009, 02:37 PM #6
Aj_Old,

I copied that code into a module window, but nothing happens in the spreadsheet. I clicked on the run button as well and still nothing. I'm very much a newbie when it comes to VB code in excel.. is there something else I'm supposed to do to execute that code?

Thanks
The Villan's Avatar
Senior Member with 2,003 posts.
 
Join Date: Feb 2006
Location: Lincolnshire UK
Experience: Advanced at times
01-Nov-2009, 03:59 PM #7
Why is this marked as solved. Doesn't seem like it to me.
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
01-Nov-2009, 04:28 PM #8
@The Villain:
I must have done that accidentally.. my apologies.
I just set it back to Unsolved.

@Aj_old:
I take back my last post... I played around with the picture path string as my pictures are in a subfolder called images (I changed that line of code to look like this: pict_path = ThisWorkbook.Path & "\images\".
It seems to be working now (yay!) except it just a few minor tweaks.

1. If I re-run the odbc query to get a new list, it lays the new pics over the old ones. Is there a way to delete the old pictures before fetching the new ones?

2. The picture hight on the pics seems perfect, but for the width I can see the right hand border of the cell behind sticking out. So the cells with long image names are sticking out a little from behind the picture. I realize that this is because the image size I requested is 125x125 pixels and some of the image names are longer than that. So is there a way to hide the image name column (I don't really need to discplay the image name in the report) and display the actual image in another column?

3. Is it possible to automatically display a border around each picture to match the rest of the cells?


Thanks again for spending the time to help me!
The Villan's Avatar
Senior Member with 2,003 posts.
 
Join Date: Feb 2006
Location: Lincolnshire UK
Experience: Advanced at times
01-Nov-2009, 04:37 PM #9
No Problems Skam, just wondered :-)
Aj_old's Avatar
Computer Specs
Senior Member with 869 posts.
 
Join Date: Sep 2007
Location: Moldova
Experience: Intermediate
02-Nov-2009, 03:28 AM #10
I modified a little the code so it should do what you need.
Code:
Sub InsertPictures()
    col = "H" 'Change the column letter to corespond to the column where the filenames are stored
    nr_pictures = ActiveSheet.Cells(65356, col).End(xlUp).Row
    pict_path = ThisWorkbook.Path & "\"
    
    'Will delete the old pictures
    For Each pict In ActiveWorkbook.ActiveSheet.Shapes
        pict.Delete
    Next
    
    'Will hide the column with picture name
    Columns(col & ":" & col).EntireColumn.Hidden = True

    
    Rows("2:65536").EntireRow.AutoFit
    
    col_range = Cells(1, col).Offset(0, 1).Column
    For i = 2 To nr_pictures 'If your data do not stat with row 2, change i=2 to the coresponding value
        InsertPicture pict_path & Cells(i, col).Value, Cells(i, col_range)
    Next
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)


    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        .ColumnWidth = 20
        .RowHeight = 93.75
    End With
    
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
    
    ' resize picture
    With p
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = Application.CentimetersToPoints(3.3)
        .Height = Application.CentimetersToPoints(3.3)

        .ShapeRange.Line.Weight = 1.5
        .ShapeRange.Line.DashStyle = msoLineSolid
        .ShapeRange.Line.Style = msoLineSingle
        .ShapeRange.Line.Transparency = 0#
        .ShapeRange.Line.Visible = msoTrue
        .ShapeRange.Line.ForeColor.SchemeColor = 64
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    End With
    
    Set p = Nothing
End Sub
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
08-Nov-2009, 12:39 AM #11
Aj_old,

This seems to do exactly what I need! Awesome!

I just need to test it out with my client and if all goes smoothly I'll mark this thread as solved.

Thanks so much for your help!
Aj_old's Avatar
Computer Specs
Senior Member with 869 posts.
 
Join Date: Sep 2007
Location: Moldova
Experience: Intermediate
09-Nov-2009, 02:19 AM #12
You are welcome, just tell us the results, so we know what went good, and what not.
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
27-Nov-2009, 11:54 AM #13
Hi,

I finally got in touch with my client and we got it up and running.
It all worked perfectly except for one thing.

There are some cases where the image name field will be blank for a given row, or there will be an image name there that does not exist in the image directory. In those cases, there's an image in the image directory called "noimage.gif" which simply displays "No Image Available"... I'd like to display that image in those 2 cases.

Here's the code I'm using:

Code:
Sub InsertPictures()
    col = "H" 'Change the column letter to corespond to the column where the filenames are stored
    'col2 = "I" 'Column where pics will be displayed
    nr_pictures = ActiveSheet.Cells(65356, col).End(xlUp).Row
    pict_path = ThisWorkbook.Path & "\images\"
 
    'Will delete the old pictures
    For Each pict In ActiveWorkbook.ActiveSheet.Shapes
        pict.Delete
    Next
 
    'Will hide the column with picture name
    Columns(col & ":" & col).EntireColumn.Hidden = True
 
    Rows("2:65536").EntireRow.AutoFit
 
    col_range = Cells(1, col).Offset(0, 2).Column
    For i = 2 To nr_pictures 'If your data do not stat with row 2, change i=2 to the coresponding value
        InsertPicture pict_path & Cells(i, col).Value, Cells(i, col_range)
    Next
End Sub
Sub InsertPicture(PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
 
    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        .ColumnWidth = 20
        .RowHeight = 93.75
    End With
 
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
 
    ' resize picture
    With p
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = Application.CentimetersToPoints(3.3)
        .Height = Application.CentimetersToPoints(3.3)
        .ShapeRange.Line.Weight = 0.1
        .ShapeRange.Line.DashStyle = msoLineSolid
        .ShapeRange.Line.Style = msoLineSingle
        .ShapeRange.Line.Transparency = 0#
        .ShapeRange.Line.Visible = msoTrue
        .ShapeRange.Line.ForeColor.SchemeColor = 44
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    End With
 
    Set p = Nothing
End Sub
Hope that made sense.
Again, I appreciate your help.
skam1's Avatar
Junior Member with 10 posts.
 
Join Date: Oct 2009
Experience: Intermediate
03-Dec-2009, 05:01 PM #14
bump
Aj_old's Avatar
Computer Specs
Senior Member with 869 posts.
 
Join Date: Sep 2007
Location: Moldova
Experience: Intermediate
05-Dec-2009, 03:51 PM #15
Try this code, it should work, just find in the second part of the code the noimage.gif, and change it to the name of your file that corresponds to no image situation.

Code:
Sub InsertPictures()
    Application.ScreenUpdating = False
    
    col = "H" 'Change the column letter to corespond to the column where the filenames are stored
    'col2 = "I" 'Column where pics will be displayed
    nr_pictures = ActiveSheet.Cells(65356, col).End(xlUp).Row
    pict_path = ThisWorkbook.Path & "\images\"
 
    'Will delete the old pictures
    For Each pict In ActiveWorkbook.ActiveSheet.Shapes
        pict.Delete
    Next
 
    'Will hide the column with picture name
    If Not (Columns(col & ":" & col).EntireColumn.Hidden) Then Columns(col & ":" & col).EntireColumn.Hidden = True
 
    Rows("2:65536").EntireRow.AutoFit
 
    col_range = Cells(1, col).Offset(0, 2).Column
    For i = 2 To nr_pictures 'If your data do not stat with row 2, change i=2 to the coresponding value
        InsertPicture pict_path, Cells(i, col).Value, Cells(i, col_range)
    Next
    
    Application.ScreenUpdating = True

End Sub
Sub InsertPicture(PicturePath, PictureFileName As String, TargetCell As Range)
' inserts a picture at the top left position of TargetCell
Dim p As Object, t As Double, l As Double, w As Double, h As Double
Dim PicturePath_and_name, NoImage As String
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    'test if picture name is not empty, and replace it with noimage.gif
        NoImage = "Noimage.gif"
         If PictureFileName = "" Then PictureFileName = NoImage
    
    'Get the full file name
        PicturePath_and_name = PicturePath & PictureFileName
    
    'test if the file exists, nad if no, replace it with noimage.gif
        If Dir(PicturePath_and_name) = "" Then PicturePath_and_name = PicturePath & NoImage
    
    'import picture
        Set p = ActiveSheet.Pictures.Insert(PicturePath_and_name)
    
    
    ' determine positions
    With TargetCell
        t = .Top
        l = .Left
        .ColumnWidth = 20
        .RowHeight = 93.75
    End With
 
    ' position picture
    With p
        .Top = t
        .Left = l
    End With
 
    ' resize picture
    With p
        .ShapeRange.LockAspectRatio = msoFalse
        .Width = Application.CentimetersToPoints(3.3)
        .Height = Application.CentimetersToPoints(3.3)
        .ShapeRange.Line.Weight = 0.1
        .ShapeRange.Line.DashStyle = msoLineSolid
        .ShapeRange.Line.Style = msoLineSingle
        .ShapeRange.Line.Transparency = 0#
        .ShapeRange.Line.Visible = msoTrue
        .ShapeRange.Line.ForeColor.SchemeColor = 44
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    End With
 
    Set p = Nothing
End Sub
Reply

THIS THREAD HAS EXPIRED.
Are you having the same problem? We have volunteers ready to answer your question, but first you'll have to join for free. Need help getting started? Check out our Welcome Guide.

Search Tech Support Guy

Find the solution to your
computer problem!




Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
WELCOME TO TECH SUPPORT GUY! Are you looking for the solution to your computer problem? Join our site today to ask your question -- for free! Our site is run completely by volunteers who want to help you solve your computer problems. See our Welcome Guide to get started.
Thread Tools



Facebook Facebook Twitter Twitter TechGuy.tv TechGuy.tv Mobile TSG Mobile
You Are Using:
Server ID
Advertisements do not imply our endorsement of that product or service.
All times are GMT -4. The time now is 12:35 PM.
Copyright © 1996 - 2011 TechGuy, Inc. All rights reserved.

Powered by Cermak Technologies, Inc.