VB to Resize inserted object into Cell on Excel Worksheet

[DylaBrion]

Hi Can anyone please help with the following

I have the following code below to insert an object into selected Cells in excel

When the object icon is inserted it's size is bigger than the cell. I would like to adjust the icon to a specific size or automatically fit the cell

Is this possible in VB and if yes could you please help me with the code

Thanks

Here is my current code

Sub Button1_Click()
Dim vFile As Variant
Dim CSel As String
Set PreAttDocs = [D1]
CSel = "C7"
If Range(CSel).Value = 1 Then CSel = "D7"
If Range(CSel).Value = 1 Then CSel = "E7"
If Range(CSel).Value = 1 Then CSel = "F7"
If Range(CSel).Value = 1 Then CSel = "G7"
If Range(CSel).Value = 1 Then CSel = "H7"
If Range(CSel).Value = 1 Then CSel = "I7"
If Range(CSel).Value = 1 Then CSel = "J7"
If Range(CSel).Value = 1 Then CSel = "K7"
Range(CSel).Select
vFile = Application.GetOpenFilename("All Files,*.*", Title:="Find file to insert")
If LCase(vFile) = "false" Then Exit Sub
FN = InStrRev(vFile, "\", -1, vbTextCompare) + 1
FN2 = Mid(vFile, FN)
ActiveSheet.OLEObjects.Add Filename:= _
vFile, Link:= _
False, DisplayAsIcon:=True, IconFileName:= _
"C:\WINNT\Installer\{90140000-0011-0000-0000-0000000FF1CE}\icons.exe", _
IconIndex:=0, IconLabel:=FN2
Range(CSel).Value = 1
End Sub

 

[SkipVought]

Hi,

Sub Button1_Click()
    Dim vFile As Variant
    Dim CSel As String
    Set PreAttDocs = [D1]
    CSel = "C7"
    If Range(CSel).Value = 1 Then CSel = "D7"
    If Range(CSel).Value = 1 Then CSel = "E7"
    If Range(CSel).Value = 1 Then CSel = "F7"
    If Range(CSel).Value = 1 Then CSel = "G7"
    If Range(CSel).Value = 1 Then CSel = "H7"
    If Range(CSel).Value = 1 Then CSel = "I7"
    If Range(CSel).Value = 1 Then CSel = "J7"
    If Range(CSel).Value = 1 Then CSel = "K7"
    Range(CSel).Select
    
    vFile = Application.GetOpenFilename("All Files,*.*", Title:="Find file to insert")
    If LCase(vFile) = "false" Then Exit Sub
    FN = InStrRev(vFile, "\", -1, vbTextCompare) + 1
    FN2 = Mid(vFile, FN)
    ActiveSheet.OLEObjects.Add Filename:= _
    vFile, Link:= _
    False, DisplayAsIcon:=True, IconFileName:= _
    "C:\WINNT\Installer\{90140000-0011-0000-0000-0000000FF1CE}\icons.exe", _
    IconIndex:=0, IconLabel:=FN2
    Range(CSel).Value = 1
    
[b]    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count).OLEFormat.Object.ShapeRange
        .Left = Range(CSel).Left
        .Top = Range(CSel).Top
        .Width = Range(CSel).Width
        .Height = Range(CSel).Height
    End With
[/b]End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]
"The most incomprehensible thing about the universe is that it is comprehensible" A. Einstein

 

[DylaBrion]

Skip

Excellent and worked first time

Many Thanks for you help