chris3912
08-23-2012, 05:05 AM
Hi there, hoping someone can help!
I currently have a macro enabled image catalogue that imports images based on name (column A), location (B) and puts them in the spreadsheet however they all appear at the top of the spreadsheet as different sizes.
I was wondering if somone could modify my macro below so all the images appear the same size and in each row so they can be seen by the customer. I have also attached the spreadsheet I need to use.
Sub InsertPictures()
Dim row As Long
Dim picPath As String
Dim Picture As Object
row = 1
On Error Resume Next
While Cells(row, 1) <> ""
Cells(row, 3).Select
' just guess what type of picture it is: .jpg or .gif
picPath = Cells(row, 2) & Cells(row, 1) & ".gif"
ActiveSheet.Pictures.Insert(picPath).Select
picPath = Cells(row, 2) & Cells(row, 1) & ".jpg"
ActiveSheet.Pictures.Insert(picPath).Select
Set Picture = Selection
'set cell height to picture size
Picture.Top = Picture.TopLeftCell.Top
Picture.Left = Picture.TopLeftCell.Left
Picture.TopLeftCell.EntireRow.RowHeight = Picture.Height
row = row + 1
Wend
End Sub
Thanks for your help.
Chris
I currently have a macro enabled image catalogue that imports images based on name (column A), location (B) and puts them in the spreadsheet however they all appear at the top of the spreadsheet as different sizes.
I was wondering if somone could modify my macro below so all the images appear the same size and in each row so they can be seen by the customer. I have also attached the spreadsheet I need to use.
Sub InsertPictures()
Dim row As Long
Dim picPath As String
Dim Picture As Object
row = 1
On Error Resume Next
While Cells(row, 1) <> ""
Cells(row, 3).Select
' just guess what type of picture it is: .jpg or .gif
picPath = Cells(row, 2) & Cells(row, 1) & ".gif"
ActiveSheet.Pictures.Insert(picPath).Select
picPath = Cells(row, 2) & Cells(row, 1) & ".jpg"
ActiveSheet.Pictures.Insert(picPath).Select
Set Picture = Selection
'set cell height to picture size
Picture.Top = Picture.TopLeftCell.Top
Picture.Left = Picture.TopLeftCell.Left
Picture.TopLeftCell.EntireRow.RowHeight = Picture.Height
row = row + 1
Wend
End Sub
Thanks for your help.
Chris