How to make consistent embedded object icons' size in vba

[Vincent88]

I use the below code to insert object icons to fit active cells in a column but they are irregular. How to modify the code to fit the icon to the size of cell.

Code

Sub SelectOLE()
Dim objFileDialog As Office.FileDialog

Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)

objFileDialog.AllowMultiSelect = False
objFileDialog.ButtonName = "Select File"
objFileDialog.Title = "Select File"
objFileDialog.Show

If (objFileDialog.SelectedItems.Count > 0) Then

Set f = ActiveSheet.OLEObjects.Add _
(Filename:=objFileDialog.SelectedItems(1), _
Link:=False, _
DisplayAsIcon:=True, _
IconLabel:=objFileDialog.SelectedItems(1), _
Top:=ActiveCell.Top, _
Left:=ActiveCell.Left _
)
f.Select

f.Width = ActiveCell.Width
f.Height = ActiveCell.Height

End If

End Sub

 

[Domenic]

Try setting the LockAspectRatio to msoFalse before setting the width and height properties...

With f
    .ShapeRange.LockAspectRatio = msoFalse
    .Width = ActiveCell.Width
    .Height = ActiveCell.Height
End With

Hope this helps!

 

[Marc L]

​

Always use LockAspectRatio to True in order to respect the homothety, to not distort the picture …​

 

[Vincent88]

Try setting the LockAspectRatio to msoFalse before setting the width and height properties...

With f
    .ShapeRange.LockAspectRatio = msoFalse
    .Width = ActiveCell.Width
    .Height = ActiveCell.Height
End With

Hope this helps!

Thanks Domenic,
It works now !

 

[Vincent88]

​

Always use LockAspectRatio to True in order to respect the homothety, to not distort the picture …​

Thanks Marc,
I don't mind the icon is distort, I just want to fix its size within a cell.

 

[Domenic]

Thanks Domenic,
It works now !

You're very welcome, cheers!