I am trying to insert images from a folder into excel by matching file names specified in a column, everything is running fine but facing issue of row & column resizing according to image size.
It would be very helpful if anyone can guide to edit the below mentioned macro, so that the column & row gets resized automatic.
Thanks in Advance.
Macro mentioned below..
Private Sub CommandButton1_Click()
Dim pictureNameColumn As String
Dim picturePasteColumn As String
Dim pictureName As String
Dim lastPictureRow As Long
Dim pictureRow As Long
Dim pathForPicture As String
With Selection
.Left = Cells(pictureRow, picturePasteColumn).Left
.Top = Cells(pictureRow, picturePasteColumn).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 80#
.ShapeRange.Width = 95#
.ShapeRange.Rotation = 0#
End With
ElseIf (Dir(pathForPicture & pictureName & ".bmp") <> vbNullString) Then
Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".bmp").Select 'Path to where pictures are stored
With Selection
.Left = Cells(pictureRow, picturePasteColumn).Left
.Top = Cells(pictureRow, picturePasteColumn).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 80#
.ShapeRange.Width = 95#
.ShapeRange.Rotation = 0#
End With
Else
'picture name was there, but no such picture
Cells(pictureRow, picturePasteColumn) = "No Picture Found"
End If
Else
'picture name cell was blank
End If
'increment row count
pictureRow = pictureRow + 1
Loop
Exit_Sub:
Range("A10").Select
Application.ScreenUpdating = True
Exit Sub
All your picture sizes are the same. So you only have to adjust the columnwidth once and for the row height use:
Cells(pictureRow, picturePasteColumn).rowheight= enter numeric value here
