insert pictures

[marc747]

help please,

I need to insert pictures in excel using macro, I have picture names
in row1 (B1:G1) and I want to insert the pictures to row2 (B2:G2) each
cell has different file name, and I would want the pictures to be
resized to a 32 px and keep the ratio, and if possible be connected to
the cells.

thanks
marc

 

[Guest]

Try this code. Not sure how to reduce quality to 32K format. You need to
specify the height of the pictue in pixels. The program sets the row heigh
and then adjusts the picture size to fit the row height. the picture is
place on the worksheet based on the cells top and left properties. You may
want to make the picture a little bit smaller the then cell height.

pict.ShapeRange.Height = PictureHeight - 10

Also you may want the picture not to be at the top edge of the cell

pict.Top = Range("B" & RowCount).Top + 5


Sub add_pictures()

Const PictureHeight = 100

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows(1 & ":" & LastRow).RowHeight = PictureHeight

For RowCount = 1 To LastRow
Set pict = ActiveSheet.Pictures.Insert(Range("A" & RowCount))
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = Range("B" & RowCount).Top
pict.Left = Range("B" & RowCount).Left
Next RowCount

End Sub

 

[marc747]

Try this code. Not sure how to reduce quality to 32K format. You need to
specify the height of the pictue in pixels. The program sets the row heigh
and then adjusts the picture size to fit the row height. the picture is
place on the worksheet based on the cells top and left properties. You may
want to make the picture a little bit smaller the then cell height.

pict.ShapeRange.Height = PictureHeight - 10

Also you may want the picture not to be at the top edge of the cell

pict.Top = Range("B" & RowCount).Top + 5

Sub add_pictures()

Const PictureHeight = 100

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Rows(1 & ":" & LastRow).RowHeight = PictureHeight

For RowCount = 1 To LastRow
Set pict = ActiveSheet.Pictures.Insert(Range("A" & RowCount))
pict.ShapeRange.LockAspectRatio = msoTrue
pict.ShapeRange.Height = PictureHeight
pict.Top = Range("B" & RowCount).Top
pict.Left = Range("B" & RowCount).Left
Next RowCount

End Sub







- Show quoted text -

Thanks, but I can not get it to work, what should I do?

 

[Guest]

There is really no reason this code shouldn't work without any changes. I
fully tested the code with my version of excel 2003.

1) Make sure code is in a VBA module for the workbook that contains the
filenames in column A
2) Make sure the worksheet with the filenames are the active worksheet
3) the filenames should be complete paths with extensions such as

c:\temp\joel.bmp or c:\joel\joel.jpg

You didn't give any error information so I'm not sure of the problem.

 

[marc747]

Thanks
the first error that I get is "Compile error" "Invalid outside
procedure" and the error is for (pict.ShapeRange.Height =
PictureHeight - 10) the (PictureHeight - 10) part.

The second error, "Run-time error '1004': Unable to get the insert
property of the picture class"

Thank You,

 

[Guest]

The sub routine should start with SUB and end with END SUB. the lines above
are modification to the code below SUB to center the picture inside the cell.