Inserting .bmp image using VLOOKUP

[shashak]

I have a data table with 10 columns (=10 properties) and 30 rows of dat
from my test samples. I have listed the names of the test images in th
data table Column F as "test1", "test2", and so on. On my harddisk
have stored the images corresponding to the tests i
"C:\CTParts\test1.bmp, test2.bmp,...".

Below this data table, I have a report table with multiple rows o
data. The report table uses validation list (referencing data tabl
column A) and fills some of the remaining cells in the report's rows b
using the VLOOKUP function.

What I would like to do is to retrieve the .bmp image corresponding t
the Column F value in the report table, (E.g. Column F row 35 value b
VLOOKUP is "test1", then Column F row 35 will display the imag
test1.bmp retrieved from "C:\CTParts"), and resize the row's height t
fit the image height. All images have a fixed width but differen
heights. The images need to be shrunk to 25% of their size, whil
maintaining their aspect ratio and centered in the column.

Any help would be appreciated.
Shan

 

[Frank Kabel]

Hi
maybe try:
http://www.mcgimpsey.com/excel/lookuppics.html

 

[Bernie Deitrick]

Shank,

You could use the calculate event code, though you would want to have
another
column where you could store the current picture name and prevent
reloading pictures that are already opened. This, at least, should get you
going.
The values from column F are stored in column T, but that is easily changed.

Copy the code, right-click on the sheet tab (assumed to be named Sheet1)
and select "View Code" and then paste the code in the window that appears.

This was tested on JPG, not BMP, files, all that I had, and it worked fine.

HTH,
Bernie
MS Excel MVP


Private Sub Worksheet_Calculate()
Dim myCell As Range

If ActiveSheet.Name <> "Sheet1" Then Exit Sub

Application.EnableEvents = False

On Error Resume Next

For Each myCell In Range("F1:F30")

If myCell.Value <> myCell(1, 15).Value Then

myCell(1, 15).Value = myCell.Value

myName = "C:\CTParts\" & myCell.Value & ".bmp"

With ActiveSheet
.Shapes("Shape" & myCell.Address).Delete
myCell.Select
.Pictures.Insert(myName).Select
Selection.Name = "Shape" & myCell.Address
Selection.ShapeRange.ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft
myCell.EntireRow.RowHeight = Selection.ShapeRange.Height
myCell.Select
End With

End If
Next myCell

Application.EnableEvents = True
End Sub