mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Вставка картинок и изображений в ячейки листа Excel

Требуется макросом поместить изображение (картинку) на лист Excel?

Используйте функцию ВставитьКартинку, которая позволит вам вставить картинку в выбранную ячейку (или диапазон ячеек).

При вызове функции можно задать дополнительные дополнительные параметры, указав, следует ли подгонять картинку (или ячейку) по высоте и ширине.

Если вам требуется вставлять много изображений на лист Excel, - то вам поможет надстройка, позволяющая производить поиск изображений в заданной папке, и производить вставку картинок в ячейки или примечания

Кроме того, надстройка для вставки изображений в Excel умеет загружать картинки из интернета (по ссылкам в таблице Excel)

Бесплатно скачать надстройку вставки картинок в Excel

В этом примере демонстрируются возможные варианты применения функции вставки картинок:

Sub ПримерВставкиИзображенийНаЛист()
 
    ПутьКФайлуСКартинками = "D:\BMP\AboutForm.jpg"    ' полный путь к файлу изображения

    ' вставка картинки в ячейку A5 (размеры картинки и ячейки не меняются)
    ВставитьКартинку Cells(5, 1), ПутьКФайлуСКартинками 
 
    ' вставка картинки в ячейку F5 (ячейка подгоняется по ШИРИНЕ под картинку)
    ВставитьКартинку Cells(5, 6), ПутьКФайлуСКартинками, True
 
    ' вставка картинки в ячейку E1 (ячейка подгоняется по ВЫСОТЕ под картинку)
    ВставитьКартинку [e1], ПутьКФайлуСКартинками, , True
 
    ' вставка картинки в ячейку F2 (ячейка принимает размеры картинки)
    ВставитьКартинку Range("F2"), ПутьКФайлуСКартинками, True, True
 
    ' =========================================
    ' вставка картинки в ячейку F5 (картинка подгоняется по ШИРИНЕ под ячейку)
    ВставитьКартинку Cells(5, 6), ПутьКФайлуСКартинками, True, , True
 
    ' вставка картинки в ячейку E1 (картинка подгоняется по ВЫСОТЕ под ячейку)
    ВставитьКартинку [e1], ПутьКФайлуСКартинками, , True, True
 
    ' вставка картинки в диапазон a2:e3 (картинка вписывается в диапазон)
    ВставитьКартинку [a2:e3], ПутьКФайлуСКартинками, True, True, True
 
End Sub

А вот и сама функция (скопируйте этот код в стандартный модуль, чтобы иметь возможность вставки картинок одной строкой кода из любого макроса):

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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Здравствуйте, а возможна ли данная реализация для подтягивания графиков из ексель, в презентацию поверпоинт? Попробовал самостоятельно разработать, вышло следующее:

' Импортирует все графики в презентацию
Dim counter As Long
 
Sub ImportGraphs()
    Dim fileName As String
    Dim i
 
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
 
    Set xlApp = CreateObject("Excel.Application")
 
    fileName = xlApp.GetOpenFilename("Excel Files (*.xls), *.xls")
 
    If fileName Like "" Then
    MsgBox ("Выберите файл для импортирования данных")
    Else
    xlApp.Workbooks.Open (fileName)
 
    Set xlWorkbook = xlApp.ActiveWorkbook
    xlApp.Visible = True
 
    counter = 1
 
    For Each xlSheet In xlWorkbook.Sheets
      If xlSheet.Name Like "Диаграмма*" Then
          xlSheet.ChartArea.Copy
          PasteGraphs
        Else
         If xlSheet.ChartObjects.Count > 0 Then
           For i = 1 To xlSheet.ChartObjects.Count
             xlSheet.ChartObjects(i).Chart.ChartArea.Copy
             PasteGraphs
           Next
         End If
 
       End If
    Next
 
    End If
 
    Set xlWorkbook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub
 
Sub PasteGraphs()
   ActivePresentation.Slides.Add(Index:=counter, Layout:=ppLayoutBlank).Select
   ActiveWindow.Panes(2).Activate
   ActiveWindow.View.PasteSpecial ppPasteOLEObject, , , , , msoTrue
   '
   ' изменение размера вставленного объекта
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth 1, msoFalse, msoScaleFromBottomRight
        .ScaleHeight 1, msoFalse, msoScaleFromBottomRight
        .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1, msoFalse, msoScaleFromTopLeft
    End With
    counter = counter + 1
End Sub

Все работает отлично, но вот хотелось бы доработать автоподбор размера графика, к примеру если диаграмма небольшого размера, то в один слайд по возможности вставлялось несколько диаграмм.
Буду рад советам и благодарен за помощь + возможно так же кому то пригодится.

Здравствуйте, Александр
Так есть же готовое решение, - ссылка на надстройку для вставки картинок есть в заголовке статьи:
http://excelvba.ru/programmes/PastePictures
Кстати, в этой надстройке, в меню ДОПОЛНИТЕЛЬНО, есть опция вывода на лист списка файлов из заданной папки.

здравствуйте помогите пожалуйста!. воспользовался вашим продуктом поиска файлов в папке и подпапках. очень помог в решении задач.
возможно ли в продолжении функционала вставку картинок в список файлов который находит ваш макрос. т.е. хочу сделать автоматически через userform. если возможно с пояснениями. спасибо!

Здравствуйте, Иван
Специально для тех, кто не может разобраться в коде,
я сделал надстройку для вставки картинок в Excel
Ссылка на её скачивание приведена в начале статьи.

Я в Excel не особый знаток, мне как раз нужен макрос по вставке фото в лист. Но я не знаю как отредактировать Ваш макрос. Т.е. там многое написано по-русски (не учитывая комментарии). Если просто вставить ваш код в исходный код Excel, то ничего не работает. Помогите пожалуйста разобраться! Спасибо!

Спасибо большое! Буду пробовать

Если в макросах не разбираетесь достаточно, - то со сжатием картинок там намного сложнее,
имеет смысл всё-таки использовать готовое решение.

Сжатие (изменение размеров графического файла перед вставкой картинки):
http://excelvba.ru/code/ResizeImages

PS: можно назначить макросам из моей надстройки (PastePictures) горячие клавиши.
Пока штатными средствами надстройки этого не добиться, - но, если надо, - могу реализовать в следующих версиях.

Спасибо большое! Я к сожалению не обладаю особыми знаниями, чтобы изменять и подстраивать команды...
Вашей программой с надстройками я уже успешно пользуюсь, но все же мне хочется упростить процесс нажатием горячих клавиш.
Не могли бы Вы мне еще подсказать команду для сжатия вставляемой фотографии?

Здравствуйте, Леонид.
Этот вопрос уже неоднократно задавался в комментариях:
http://excelvba.ru/code/PastePictures#comment-2628

Для 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 2003, но в 2010-м Excel все не так, при переносе файла в ячейках вылетают ссылки. Помогите пожалуйста адаптировать данный код под 2010 Excel

    PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , "False")
    ActiveSheet.Pictures.Insert(PicLocation).Select
    Selection.ShapeRange.ScaleWidth 0.12, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.12, msoFalse, msoScaleFromTopLeft

Здравствуйте, Марина
Сами по себе картинки не уменьшатся, независимо от того, какой метод вставки вы выбираете.
Есть в Excel встроенная возможность сжать картинки, - но это, пожалуй, то единственное действие, которое программно (средствами VBA) выполнить не получится.

Моя программа использует функции WinAPI для создания уменьшенных картинок, перед вставкой на лист.
Там очень много взаимосвязанного кода (т.к. программа универсальная, и содержит кучу настроек)
Потому просто скопировать тот код из надстройки не получится.
Кроме того, я пишу макросы только для Excel, и как поведет себя этот код в 1С, - представления не имею.
Поэтому не возьмусь вам помочь.

Вариант решения проблемы, макросом из 1С:
1) запускаете Excel в скрытом режиме
2) в нём открываете созданный файл Excel и мою надстройку
3) программно запускаете макрос вставки картинок (можно перед этим программно изменить настройки вставки)
4) закрываете Excel

PS: Можете сами попробовать написать код.
Все необходимое для него есть здесь: http://excelvba.ru/code/ResizeImages
(это как раз код из моей надстройки. Вам нужен макрос «ИзменениеРазмеровКартинки»)

Здравствуйте. Мне не помог метод AddPicture с нулями. Файл по-прежнему большой создается. Возможно ли заказать у Вас изменение этого макроса, так, чтобы картинки вставлялись не ссылками и ужимались? Так, как это делает Ваша надстройка? И сколько это стоить будет?

Да, я все из 1С делаю. Когда выводила прайс с помощью AddPicture, получался файл 6 метров, когда заполняла картинки того же файла с помощью вашей надстройки - 3 метра.
Вообще использовала AddPicture с параметрами сразу установленными, попробую с нулями. Большое спасибо за ответы! А то я ни разу не VBA-программист.

Вы макрос из 1С запускаете? Т.е. вставка картинок и отправка, - всё из 1С?
(если в Excel, то можно программно управлять моей надстройкой, запуская из неё команду вставки картинок. но это только при работе с макросом из Excel)

Да, надо использовать AddPicture с параметрами 0,0,0,0
а потом позиционировать картинку на листе, и выставлять нужные размеры.

Насчёт размера картинок, - AddPicture точно такие же картинки вставляет, вроде бы
Так что размер создаваемого файла Excel от метода вставки картинок не зависит.

Да, программа хорошо вставляет) Но мне нужно формировать файл и отсылать клиентам по кнопочке, чтобы пользователи даже не заходили в Excel. Я еще пробовала метод AddPicture, но файл большой получается, он, видимо, не сжимает картинку при вставке. Т.е. не судьба, или можно еще что-то попробовать?

Здравствуйте, Марина.

Да, есть такая проблема, - по умолчанию, в Excel 2010 картинки вставляются связанными с файлами
(если использовать метод вставки Pictures.Insert)

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

В универсальной программе вставки картинок в Excel эта проблема решена, - вставленные с её помощью картинки сохраняются вместе с файлом, и можно смело рассылать файл с картинками.
Кроме того, в этой программе есть опция сжатия картинок, - что тоже немаловажно.

Здравствуйте! Я использовала Ваш макрос для вывода картинок из 1с в Excel. Но при удалении каталога с картинками вместо картинок отображается сообщение "Не удается отобразить связанный рисунок". А мне нужно файл клиентам отсылать. Что я не так делаю? Подскажите, пожалуйста!

Подскажите, пожалуйста.
Если файл Excel является общим, как тогда вставлять картинку?
Посредством данной функции вставка не происходит.

Александр, а какое отношение ваш вопрос имеет к теме статьи (к вставке картинок на лист Excel)?
Обратитесь на форумы по Excel - там вам подскажут.

как уменьшить текс в exele и копировать в word

Здравствуйте,
можете ли подсказать какими макрокомандами можно менять положение желтого ромбика на вставленный кубик? (msoShapeCube)

Картинка меняется - код вроде правильный.
Вот только пока макрос не закончит свою работу, Excel может не обновлять картинку на элементе Image1
(вроде как-то сталкивался с подобным)
Т.е. только когда цикл завершился, Excel вспоминает, что надо перерисовать картинку в Image1.
Как с этим бороться - не знаю. Если честно, вообще не понимаю, какой смысл менять картинку в цикле. Вы таким образом пытаетесь воспроизвести фильм? )

PS: А какое отношение ваш вопрос имеет к теме статьи?

Здравствуйте,
хотела, чтобы картинка менялась в цикле, но получается только в конце цикла картинка отображает последний путь, а во время цикла не меняется

x = 0
While x < 21
Sheet7.Activate
a = Лист2.Cells(2 + x, 2)
Sheet7.Cells(4, 6).Value = a
Sheet7.Cells(4, 10).Value = Лист2.Cells(2 + x, 3)
curfolder = current
p = ActiveWorkbook.Path & "\img\" & a & ".jpg"
Sheet7.Cells(4, 25).Value = p
p2 = ActiveWorkbook.Path & "\img\no.jpg"
If Dir(p, vbDirectory) <> "" Then
Sheet7.Image1.Picture = LoadPicture(p)
Else:
Sheet7.Image1.Picture = LoadPicture(p2)
End If

Sheet7.Cells(5 + x, 1).Value = Dir(p, vbDirectory)
x = x + 1
Application.Wait Now() + TimeValue("00:00:01")
Wend

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

Проверить файл на существование, если известен полный путь к файлу картинки, очень просто:
if Dir("полный путь к файлу")<>"" then msgbox "Файл существует"

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

Подскажите пожалуйста, можно ли как проверить была ли вставлена картинка методом ActiveSheet.Pictures.Insert или же нет? Возможно проще проверить существует ли файл с фотографией перед ее вставкой? Способ так же мне неизвестный. Просветите пожалуйста...

Спасибо большое администратору за оказанную помощь!!! Но у меня есть еще маленький вопросик:
у меня есть такой код (см. ниже) который из ячейки D3 берет значение пути к картинке (путь к картинке проставляется внешней программой) и вставляет картинку в ячейку E3. При чем вставляет в левый верхний угол.

1) Из этой статьи не совсем разобрался как сделать в моем коде так, чтобы ячейка принимала размер картинки, но чтобы картинки больше 100 на 50 пикселей сжимались до этого размера, и только после этого ячейка могла бы принять размер картинки.

2) Как мне оптимизировать этот код, чтобы макрос определял, какие ячейки в колонке D заполнены (например с 3 по 15 или с 3 по 26) и заполнял картинками колонку E тоже с 3 по 15 или с 3 по 26 соответственно?

With ActiveSheet.Pictures.Insert([D3])
.Top = [E3].Top
.Left = [E3].Left
.Name = [E3]
End With

Я только что направил Вам проект ТЗ о витринах и прилавках.
К ТЗ приложен файл "ИД.Витрина...". В нем динамически меняющиеся раскрывающиеся списки, меняющееся изображение витрины (выполнено в полном соответствии с Вашими рекомендациями), условное форматирование и подсказки "для защиты от дурака". Над размерными линиями надо проставить размеры из таблицы, но ячейки под рисунком не видны (рис.не прозрачный), а текстовое поле НЕ УДАЕТСЯ ПОВЕРХ НЕГО поставить. Почему? - не понимаю... (Ведь, если действовать через меню Вставить/Рисунок, то удается текстовое поле поставить поверх рисунка).

Прим.: В "ИД.Витрина..." управление раскрывающимися списками и условным форматированием осуществляется с скрытого листа.

Насчёт размера файла - проблему легко решить, обработав все ваши картинки специальной программой (которая в пакетном режиме обработает все изображения, уменьшив вес фотографий до 20-80кБ, - достаточно уменьшить размеры картинок или глубину цвета)

Выводить текст на листе Excel в текстбокс - зачем, когда для этого есть ячейки?
Но, если уж так нужен текстбокс, - и его сделать не проблема.
Попробовал - текстовое поле без проблем нарисовалось поверх картинки:

PS: Для подобных вопросов есть форумы по Excel
На этом сайте я обычно помогаю не бесплатно)

Поступил как указано в Ответе #26...
Мой файл при этом "потолстел" в 10 раз (с 506КБ, до 61000КБ).
Так не должно быть.
Прим.: вставляемая в Image2 картинка вести 3900КБ.

Действительно, "всё гениальное просто".
Спасибо!!! Стыдно, но деваться не куда, буду краснеть дальше....
Возникла еще одна проблемка:
Я хотел поверх Image1 (изменяющиеся изображения витрин в зависимости от выбранного в раскрывающ.списке) поместить меняющиеся надписи -габаритные размеры (TextBox), связав их с значениями в ячейках. Однако, не удается поместить эти TextBox над Imege1. Из меню под правой кнопкой мыши не удается выполнить ни "На передний план", ни "На задний план".
Как поступить?

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

При изменении ячеек на листе сработает обработчик Worksheet_Change, а изобретенный вами Worksheet_Ch не сработает ни при каких обстоятельствах.

Замените эти 2 обработчика событий одним:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [AE22:AE23]) Is Nothing Then ОбновлениеКартинкиВитрины
If Not Intersect(Target, [AE26]) Is Nothing Then ОбновлениеКартинкиСтоек
End Sub

Спасибо еще раз! Макрос и процедура работают замечательно!
Но... Захотелось по аналогии пристегнуть сменяющиеся картинки еще к одному раскрывающемуся списку и обломился. Не пойму почему. Подскажите - где ошибка?

Sub ОбновлениеКартинкиВитрины()
On Error Resume Next
Set [Image1].Object.Picture = Nothing
Set [Image1].Object.Picture = LoadPicture([Место_хранения_рисунка_витрины])
End Sub

Sub ОбновлениеКартинкиСтоек()
On Error Resume Next
Set [Image2].Object.Picture = Nothing
Set [Image2].Object.Picture = LoadPicture([Место_хранения_рисунка_стойки])
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [AE22:AE23]) Is Nothing Then ОбновлениеКартинкиВитрины
End Sub

Private Sub Worksheet_Ch(ByVal Target As Range)
If Not Intersect(Target, [AE26:AE26]) Is Nothing Then ОбновлениеКартинкиСтоек
End Sub

Макрос "Обновление картинки стоек" работает, но процедура, привязанная к изменению в ячейке AE26 не запускается. Почему?

СУППЕРРР!
Спасибо громадное!
Подскажите, где можно поучиться VBA для Exel в СПб?

Огромное С П А С И Б О!!!

Да неужели...
смотрите второй способ в этой статье:
http://www.planetaexcel.ru/tip.php?aid=34
вот ещё один способ:
http://www.planetaexcel.ru/tip.php?aid=70

..И тут же получу сообщение " Для условий "Проверка данных" нельзя использовать ссылки на другие листы"

Сделать это просто - присваиваете имя списку фирм, и в "данные\проверка\список..." указываете ссылку на именованный диапазон.

Как сделать ввод фирм в таблицу со списком, если список фирм расположен на другой странице?
(данные\проверка\список...)?

Макрос ОбновлениеКартинки - в стандартный модуль,
обработчик Worksheet_Change - в модуль листа.

Пример в файле: http://excelvba.ru/XL_Files/Sample__04-11-2011__13-22-08.zip

А как сделать, чтобы Процедура "Worksheet_Change" начала работать?
Куда и как её поместить?

Спасибо за оперативный ответ!
Попробую на выходных в домашних условиях.

Николай, всё делается проще, чем вы думаете.

Сначала вставляете в ячейку элемент управления Image:

а потом делаете макрос, изменяющий свойство Picture этого объекта:

Sub ОбновлениеКартинки()
    On Error Resume Next
 
    ' удаляем старую картинку
    Set [Image1].Object.Picture = Nothing
 
    ' добавляем новую
    Set [Image1].Object.Picture = LoadPicture([d5])
End Sub

Осталось вызвать этот макрос при изменении ячейки С3 или C4:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [c3:c4]) Is Nothing Then ОбновлениеКартинки
End Sub

Выше написанное Впечатляет, но для новичка…

На листе 30 раскрывающихся списков (Данные/проверка вводимых значений/список/...).
При изменении значений в ДВУХ списках (ячейка C3 и C4), в соседней ячейке (D5) изменяется путь к картинкам "\\Slim\fileupload\Витрины, прилавки\Рисунки\....jpg".
Надо МЕНЯТЬ картинки при изменении С3 или C4 (старая картинка должна удалятся, новая размещается на её место).
Картики надо вносить в ячейку A20 без изменения размеров ячейки и без изменения размеров картинки.
Макрос должен запускаться тоько при внесении изменений в C3 и/или С4 (при других действиях на листе макрос не должен запускается).

Подмогните, пожалуйста!

А я разве говорил, что копировать надо вручную?
С этим и макрос легко справится...

Вам подойдёт простейший макрос, который копирует первые строки всех файлов в итоговый файл
(в итоговый файл скопируется всё, вместе с картинками)

Скопировать ручками то понятно, я бы тогда у вас не спрашивал. :) Просто есть допустим 20-30 эксельных файлов, внутри которых на первом листе заполнены три столбца в первом ряду, т.е. три ячейки. В первых двух ячейках текст, а в третьей ячейке картинка. Задача в том, чтобы все эти 20-30 файлов (которые называются 1.xls, 2.xls, 3.xls и т.д.) превратить в один файл, у которого будут заполнены соответственно 20-30 первых строк.

А вы не пробовали просто скопировать ячейку с картинкой из одного файла в другой?
Это, пожалуй, самый простой способ.

Можно использовать также функцию getShape:

Function getShape(ByRef cell As Range) As Shape
    Dim sha As Shape
    For Each sha In cell.Worksheet.Shapes
        If sha.TopLeftCell.Address = cell.Address Then
            Set getShape = sha: Exit Function
        End If
    Next sha
End Function
 
Sub КопированиеКартинки()
    getShape([c1]).Copy [c2]
End Sub

Подскажите плиз, как из одного эксельного файла вставить картинку в другой эксельный файл?
Допустим картинка в первом файле находится в (или "над") ячейке C1 и эту картинку нужно вставить в ячейку C2, но уже в другой файл?

Мои Вам благодарности, разобрался со всем.

Ну почему же... макрорекордер записывает и вставку, и удаление картинки:

Sub Макрос2()
'
' Макрос2 Макрос
' Макрос записан 07.10.2011 (Игорь (EducatedFool))
'

    ActiveSheet.Pictures.Insert("D:\Документы\Мои рисунки\123.jpg").Select
    Selection.Delete
End Sub

Но этот макрос можно записать только в Excel 2003 (или более ранних версиях) и Excel 2010.
В Excel 2007 разработчики что-то намудрили с макрорекордером, и он очень много чего не записывает.
Так что проще всего вам будет установить (дополнительно) другую версию Excel - Excel 2007 в этом плане неудачен.

PS: Удалить картинку, зная её название, можно так:

ActiveSheet.Shapes("Рисунок 2").Delete

Макрос - это, конечно, великолепно придумано, однако же, как Вам достоверно известно, если начать запись макроса и, выделив картинку, затем бесповортно удалить ее, то код макроса будет предательски пуст, ни единой строчки в теле функции... Как же быть? Не подскажите функцию по удалению из Книги конкретной картиночки, а?)

Вообще, удаление мне нужно это для того, чтобы динамически обновлять картинку при выборе одной из строк на другом листе (удалил - вставил на то самое мето). Это позволит не вставлять все файлы изображений сразу и соответственно разгрузить саму Книгу, храня изображения отдельно.

Не проще, ибо изображения должны быть на листе для последующей печати.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _               ___    _  _                 
| |__ __ __ / _ \ | || | _ __ ___
| '_ \ \ \/ / | (_) | | || |_ | '_ \ / __|
| |_) | > < \__, | |__ _| | |_) | \__ \
|_.__/ /_/\_\ /_/ |_| | .__/ |___/
|_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.