Bulk insert images and want to lock aspect ratio

[tangsunx]

Hi,

May I know how to lock aspect ratio by editing below code?

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Helvetica Neue'}</style>Sub InsertPicFromFile()
    Dim xRg As Range
    Dim xCell As Range
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select file path cells:", "Insert Imagesl", Selection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For Each xCell In xRg
        xVal = xCell.Value
        If xVal <> "" Then
            ActiveSheet.Shapes.AddPicture xCell.Value, msoFalse, msoTrue, _
            xCell.Offset(0, 1).Left, xCell.Top, xCell.Height, _
            xCell.Height
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Thanks!

 

[ravisingh]

Try replacing the operative part of the code as under

ActiveSheet.Shapes.AddPicture xCell.Value, msoFalse, msoTrue, xCell.Offset(0, 1).Left, xCell.Top, -1, -1

This will paste the pic in original size - then you can get the dimensions of the newly pasted pic, determine the aspect ratio and then scale up/scale down the size as per your requirement while keeping the aspect ratio intact. This will need additional code.

 

[tangsunx]

Thanks!

May I know how to add additional code?
For example, I would to set the image height=100 or just fit to the cell in aspect ratio.

 

[ravisingh]

You can programatically get the height and width of the picture with pic.height and pic.width - lock the aspect ratio with LockAspectRatio method...do many things....just read the VBA help - the code you have posted indicates that you can easily do this....

 

[tangsunx]

cannot LockAspectRation also fit for cell height...

 

[ravisingh]

If you wish to fit it in the cell height, set the height of the embedded pic to cell height while keeping LockAspectRatio=True
e.g.
selection.shaperange.lockaspectratio=True
selection.Height=xcell.RowHeight

This will fit to cell height and proportionately set the width automatically.
Note: The sample code assumes the object is selected...modify the code if needed.