Страницы: 1
RSS
Картинка вставляется с привязкой к файлу картинки
 
Здравствуйте. Подскажите, Как вставить макросом картинку на лист без привязки к файлу картинки? Макрос который использую, почему-то вставляет с привязкой и на другом компьютере картинка не открывается. Вот строка VBA которую использую для вставки:
Код
    Dim ph As Picture
    Set ph = PicRange.Parent.Pictures.Insert(PicPath)

Может, какие-то свойства рисунка надо прописать дополнительно?
 
А это точно в Excel?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Да. Это точно в Excel
 
Тогда приведите код полностью. Ибо совсем неясно зачем использовать недокументированный метод вместо документированного AddPicture, в котором есть возможность вставить БЕЗ ссылки
Код
Set ph = PicRange.Parent.Shapes.AddPicture(PicPath,msoFalse)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Это не мой код. Делал программист. Зачем так- сам не знаю. В эту процедуру передаю значения для вставки, но рисунок вставляется привязанным к файлу картинки
Код
Sub ВставитьКартинку(ByRef PicRange As Range, ByVal PicPath As String, _
                    Optional ByVal AdjustWidth As Boolean, _
                    Optional ByVal AdjustHeight As Boolean, _
                    Optional ByVal AdjustPicture As Boolean = False)
   ' ==========  функция получает в качестве параметров:  ====================
   ' PicRange - прямоугольный диапазон ячеек, поверх которого будет расположено изображение
   ' PicPath - полный путь к файлу картинки (файл в формате JPG, BMP, PNG, и т.д.)
   ' AdjustWidth - если TRUE, то включен режим подбора ширины (подгонка по высоте)
   ' AdjustHeight - если TRUE, то включен режим подбора высоты (подгонка по ширине)
   ' AdjustPicture - если TRUE, то подгоняются размеры картинки под ячейку,
   '                 если FALSE (по умолчанию), то изменяются размеры ячейки

   On Error Resume Next: Application.ScreenUpdating = False
   ' вставка изображения на лист
   Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)
   ' совмещаем левый верхний угол ячейки и картинки
   ph.Top = PicRange.Top: ph.Left = PicRange.Left

   K_picture = ph.Width / ph.Height    ' вычисляем соотношение размеров сторон картинки
   K_PicRange = PicRange.Width / PicRange.Height    ' вычисляем соотношение размеров сторон диапазона ячеек

   If AdjustPicture Then    ' ПОДГОНЯЕМ РАЗМЕРЫ ИЗОБРАЖЕНИЯ под ячейку (оптимальный вариант)

       ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину
       If AdjustWidth Then ph.Width = PicRange.Width: ph.Height = ph.Width / K_picture

       ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту
       If AdjustHeight Then ph.Height = PicRange.Height: ph.Width = ph.Height * K_picture

       ' AdjustWidth=TRUE и AdjustHeight=TRUE: вписываем картинку в ячейку (без соблюдения пропорций)
       If AdjustWidth And AdjustHeight Then ph.Width = PicRange.Width: ph.Height = PicRange.Height


   Else    ' ИЗМЕНЯЕМ РАЗМЕРЫ ЯЧЕЙКИ под размеры изображения (нежелательно при вставке НЕСКОЛЬКИХ картинок...)

       If AdjustWidth Then    ' если AdjustWidth=TRUE, то высоту не трогаем - изменяем ширину
           PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth * ph.Width / PicRange.Cells(1).Width
           While Abs(PicRange.Cells(1).Width - ph.Width) > 0.1    ' точный подбор ширины ячейки
               PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)
           Wend
       End If

       If AdjustHeight Then    ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту
           PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height
           While Abs(PicRange.Cells(1).Height - ph.Height) > 0.1    ' точный подбор высоты ячейки
               PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)
           Wend
       End If

   End If
End Sub
Изменено: Radomir-m - 20.03.2020 19:18:45
 
1. На форуме коды принято оформлять соответствующим тегом(кнопочка <...>). Читать их в таком виде не очень удобно.
2. В коде нет принципиального использования именно типа Picture, поэтому можно эти строки:
Код
Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)
заменить на такие:
Код
Dim ph As Shape: Set ph = PicRange.Parent.Shapes.AddPicture(PicPath,msoFalse)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Radomir-m, исправьте свой #5 - используйте тег кода.
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
1Dim ph As Shape: Set ph = PicRange.Parent.Shapes.AddPicture(PicPath,msoFalse)
Заменил, ничего не изменилось, но этого уже достаточно. Буду искать ошибку, спасибо  :)  
Изменено: Radomir-m - 20.03.2020 23:12:52
 
Код
Set ph = ActiveSheet.Shapes.AddPicture(PicPath, False, True, 0, 0, -1, -1).Select
K_picture = Selection.ShapeRange.Height / Selection.ShapeRange.Width
Selection.ShapeRange.Height = 122
Selection.ShapeRange.Width = 122 / K_picture

Вот так работает. По-тупому, но работает :-)
Изменено: Radomir-m - 21.03.2020 12:41:00
 
Цитата
Radomir-m написал:
По-тупому, но работает
и то скорее всего потому, что есть строка On Error Resume Next в самом начале кода.
По идее код должен бы выдать ошибку, т.к. идет присвоение и выделение объекта одновременно(set ph = ...Select)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Наверх