Embedding OLEObject in Specific Cell

[Boots6]

Hello,

I have a Code that inserts an embedded object (a picture) into an excel and puts a preview of the picture into Cell "D36". I want to find a way to Set the Object (which is just an icon when double clicked pulls up the full view of the picture) to a certain cell with that cell's dimensions or at least make it smaller and put it above the picture. The preview picture part isn't important so if that has to go, no big deal. Also, I do not want to use the Insert Picture Method because this is going on a form and needs to be embedded in a small area, but able to be blown up and seen full screen. Here is my code:

Sub EmbedPicture()
Dim strFile As String, pic As Picture
strFile = Application.GetOpenFilename
If strFile = "False" Then Exit Sub
ChDir "C:\Local Cloud\Shared\PROJECTS\828 City Set\File Cabinet\Photos"
Filename = ActiveSheet.OLEObjects.Add(Filename:=strFile, _
Link:=False, DisplayAsIcon:=False).Select

Set pic = ActiveSheet.Pictures.Insert(strFile)
With pic
ActivateCell:
.ShapeRange.LockAspectRatio = msoFalse
.Height = Range("D36").Height
.Width = Range("D36").Width
.Top = Range("D36").Top
.Left = Range("D36").Left
.Placement = xlMoveAndSize
End With

Set pic = Nothing

End Sub


Also, the ChDir was working yesterday when I first made this, but not today. Any reason why this is happening? Thanks!

 

[combo]

At least till 2003 version objects can be only in the drawing layer of the worksheet.
As for the second problem, you may need proper ChDrive set first if the current drive is different from pointed in ChDir.


combo