auto size the jpeg files into excel while importing and inserting pictures

[Raju Chacha]

Is there an add-in that will auto size a picture within a specified area without having to resize it all the time. I'm trying to design my own trading journal and need to import screen shots saved as jpeg file into a specified area. Any help would be greatly appreciated.

[QUENBY]

You need to read, for example, the width of both the range where you are pasting, and the width of
the jpg:

With ActiveSheet
'Select the cell where the picture is placed
Range("rngForJPG").Cells(1,1).Select
'Insert the picture
.Pictures.Insert(myImageFileName).Select
'scale the picture to the width of the column
myScale = Range("rngForJPG").Cells(1,1).EntireColumn.Width / Selection.ShapeRange.Width
Selection.ShapeRange.ScaleWidth myScale, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight myScale, msoFalse, msoScaleFromTopLeft
'Change the row height to the picture height
Range("rngForJPG").Cells(1,1).EntireRow.RowHeight = Selection.ShapeRange.Height
End With

This may help you out.

[Leanne]

Select the cells (either manually or in code) where you want the picture to go, and then run this macro.

Sub InsertAndResizePicture()
Dim myR As Range
Set myR = Selection
'Insert the picture
ActiveSheet.Pictures.Insert( _Application.GetOpenFilename( _
"JPG picture files (*.jpg),*.jpg", , "Select the picture")).Select
'scale the picture to the width of the column
myScale = Application.Min(myR.Width / Selection.ShapeRange.Width, _
myR.Height / Selection.ShapeRange.Height)
Selection.ShapeRange.ScaleWidth myScale, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight myScale, msoFalse, msoScaleFromTopLeft
myR.select

End Sub


You of course can modify it to choose the range and filenames in code...


Sub InsertAndResizePicture2()

Dim myR As Range
Set myR = Range("Range_Name")
'Insert the picture
ActiveSheet.Pictures.Insert( "C:\PictureFiles\Picture1.jpg").Select
'scale the picture to the width of the column
myScale = Application.Min(myR.Width / Selection.ShapeRange.Width, _
myR.Height / Selection.ShapeRange.Height)
Selection.ShapeRange.ScaleWidth myScale, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight myScale, msoFalse, msoScaleFromTopLeft
myR.Select
End Sub

[DanielaA]

You of course can modify it to choose the range and filenames in code.

Sub InsertAndResizePicture2()
Dim myR As Range
Set myR = Range("Range_Name")
'Insert the picture
ActiveSheet.Pictures.Insert( "C:\PictureFiles\Picture1.jpg").Select
'scale the picture to the width of the column
myScale = Application.Min(myR.Width / Selection.ShapeRange.Width, _
myR.Height / Selection.ShapeRange.Height)
Selection.ShapeRange.ScaleWidth myScale, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight myScale, msoFalse, msoScaleFromTopLeft
myR.Select
End Sub