Function PasteOLEobject(ByVal filename$, ByRef TopLeftCell As Range, _
Optional ByVal Width%, Optional ByVal Height%) As ShapeRange
' вставляет на лист объект OLE (из файла filename$)
' и размещает его в нужном месте, совмещая левый верхний угол с ячейкой TopLeftCell
' если указаны размеры Width% или Height% - они задаются вствляемому объекту
On Error Resume Next: Err.Clear
Set PasteOLEobject = TopLeftCell.Worksheet.OLEObjects.Add(, filename$).ShapeRange
If Err Then MsgBox "Вставка объекта невозможна!", vbCritical: End
PasteOLEobject.Top = TopLeftCell.Top: PasteOLEobject.Left = TopLeftCell.Left
On Error GoTo 0
If Height% Then PasteOLEobject.Height = Height%
If Width% Then PasteOLEobject.Width = Width%
PasteOLEobject.Parent.Placement = xlFreeFloating ' убираем привязку к ячейкам
PasteOLEobject.Line.Visible = 0 ' убираем рамку вокруг объекта
End Function
Sub ПримерИспользования_PasteOLEobject()
filename = "D:\Проекты\описания\ИмяФайла.doc"
' вставляем объект шириной 575 пикселов, при этом подгоняя высоту строки под объект
ActiveCell.RowHeight = PasteOLEobject(filename, ActiveCell, 575).Height
End Sub
|
