VBA code to fit object size as cell size

[kkyuvaraj]

Hi,
I have a below VBA code to attach an object in a defined cell in a Worksheet.

In the below code, the attached object is not fit to the size of the cell height & width, hence i need to add code in below code to fit the the attached object to the cell height & width.

And also i need to add the code to call for a message box if no file is selected using below code.(Like MsgBox "No item selected.", vbInformation, "NO SELECTION").If any file selected and uploaded then this message box should not appear.

I am using below macro code in a Button to attach an object.

Public Sub insertFile()

'Select the cell in which you want to place the attachment
Range("D6").Select

'Get file path
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
If LCase(fpath) = "false" Then Exit Sub

'Insert file
ActiveSheet.OLEObjects.Add _
Filename:=fpath, _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="explorer.exe", _
IconIndex:=0, _
IconLabel:=extractFileName(fpath)

End Sub


Public Function extractFileName(filePath)

For i = Len(filePath) To 1 Step -1
If Mid(filePath, i, 1) = "\" Then
extractFileName = Mid(filePath, i + 1, Len(filePath) - i + 1)
Exit Function
End If
Next

End Function

 

[GWteB]

i need to add code in below code to fit the the attached object to the cell height & width.

I don't want to discourage you too much, but that will be a tough job. Take a look over here ....