Внедрённый рисунок в Excel 2010 и 2013

[bel62]

С другой программы через скрипт внедряю в вновь создаваемую книгу Еxcel 2007 рисунок типа WMF или JPEG. Затем исходный рисунок удаляется с компьютера. В Еxcel 2007 всё внедрённое сохраняется.
Почему то же самое невозможно сделать для Excel 2010 и 2013, то есть остается связь с источником рисунка. После удаления исходного рисунка с компьютера, теряется и внедрённый рисунок в Excel 2010 и 2013.

[IgorGO]

а посмотрите в свойства рисунка, возможно внедряется не сам рисунок а ссылка на него, и возможно этим можно управлять.

это мысли вслух. я остановился на 2007, следующих офисов не видел.

[bel62]

Сообщение от IgorGO

а посмотрите в свойства рисунка, возможно внедряется не сам рисунок а ссылка на него, и возможно этим можно управлять.

это мысли вслух. я остановился на 2007, следующих офисов не видел.

Так и есть. В 2010 и 2013 внедряется не сам рисунок а ссылка на него, а в 2007 внедряется сам рисунок. Думаю что-то в установочных файлах Excel надо менять. Но в каких?

[EducatedFool]

Так устроены новые версии Excel
Просто макрос надо немного другой:
http://excelvba.ru/code/PastePictures#comment-3126

Для Excel 2010 нужен другой способ вставки картинок, более сложный: не Pictures.Insert, а Shapes.AddPicture

Sub ВставкаКартинкиВВыделенныйДиапазонЯчеек()
    PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , False)
    If PicLocation = False Then Exit Sub        ' если отказ от выбора файла

    With ActiveSheet.Shapes.AddPicture(PicLocation, msoFalse, msoCTrue, 0, 0, 0, 0)
        .Top = Selection.Top
        .Left = Selection.Left
        .Width = Selection.Width
        .Height = Selection.Height
    End With
End Sub

Перед использованием этого макроса, выделите диапазон ячеек, куда будет вставлена картинка

А если надоест макросы писать, - можно воспользоваться готовым решением (моей надстройкой для вставки картинок, которая корректно вставляет любые картинки в любой версии Excel):
http://excelvba.ru/programmes/PastePictures

[bel62]

Сообщение от EducatedFool

Так устроены новые версии Excel
Просто макрос надо немного другой:
[B][url]http://excelvba.ru/code/PastePictures#comment-3126[/urlB]

Вот у меня скрипт для 2007. Как будет он выглядеть для 2010 (с помощью Shapes.AddPicture)?

Function InsertJPEGPicture(szJPEGPath, WScale)
Dim lWscale
Dim Aspect
Dim Shift

lWscale = Eval(WScale)*1.0

' Привяжемся к верхнему левому углу
rr="A2"
ObjExc.ActiveSheet.PageSetup.Orient ation = 2
objExc.ActiveSheet.Range(rr).Select
Set r1 = objExc.Range("A2:O33")
Set a = ObjExc.ActiveSheet.Pictures.Insert( szJPEGPath)
a.ShapeRange.LockAspectRatio = 0'WScale
a.ShapeRange.Height = r1.Height
a.ShapeRange.Width = r1.Width
Aspect = r1.Height / r1.Width

If lWscale < Aspect Then
a.ShapeRange.ScaleHeight (lWscale/Aspect), msoFalse, msoScaleFromTopLeft
a.ShapeRange.ScaleHeight (1.1), msoFalse, msoScaleFromTopLeft
a.ShapeRange.ScaleWidth (0.9), msoFalse, msoScaleFromTopLeft
a.ShapeRange.IncrementLeft (r1.Width*(0.1)/2)
Else
Shift = (r1.Width-r1.Width*(Aspect/lWscale))/2
a.ShapeRange.ScaleWidth (Aspect/lWscale), msoFalse, msoScaleFromTopLeft
a.ShapeRange.IncrementLeft Shift
End If

End Function